perm filename IOSER.OLD[NEW,AIL] blob
sn#410583 filedate 1979-01-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00035 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 HISTORY
C00012 00003 Indices, Bits for IOSER
C00015 00004 Simio, Ioinst, Lpryer, Cserr
C00026 00005 Getchn
C00029 00006 Filnam
C00036 00007 Flscan
C00041 00008 Open
C00047 00009
C00053 00010 Release
C00058 00011 Lookup, Enter
C00062 00012
C00063 00013 Fileinfo
C00065 00014 Out
C00069 00015 Input
C00079 00016 IFN ALWAYS,<BEGIN NUMIN>
C00085 00017 NUMIN: SET UP TO READ FROM A CHANNEL
C00088 00018 LNUMIN NUMBER INPUT
C00091 00019 GETNUM GETNU1
C00094 00020 DFSC
C00098 00021 DMUL..
C00101 00022 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
C00103 00023 Arryout, Wordout
C00108 00024 Arryin, Wordin
C00118 00025 Linout
C00120 00026 Breakset,setbreak,stdbrk fakes
C00121 00027 Close, Closin, Closo
C00123 00028 Mtape
C00125 00029 Useti, Useto, Rename
C00128 00030 where Usercon used to be
C00129 00031 Ttyuuo functions
C00147 00032 Ptyuuo functions
C00155 00033 TMPIN (input from a tmpcor file)
C00162 00034 TMPOUT (output to a tmpcor file)
C00170 00035
C00171 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000075 ⊗;
COMMENT ⊗
VERSION 17-1(61) 10-18-74 BY rls check herefks
VERSION 17-1(60) 10-14-74 BY JFR FIX BUG IN INPUT
VERSION 17-1(59) 10-14-74 BY JFR REMOVE HACK'S
VERSION 17-1(58) 10-13-74 BY JFR %BS% BREAK TABLE BUGS
VERSION 17-1(57) 10-11-74 BY JFR FIS TYPOS %BS%
VERSION 17-1(56) 10-11-74 BY JFR MINOR FIX TO INPUT %BS%
VERSION 17-1(55) 10-11-74 BY RHT FEAT %BQ% MAKE CLOSE TAKE INHIBIT BITS AS ARG
VERSION 17-1(54) 10-11-74 BY JFR REMOVE HEREFK'S
VERSION 17-1(53) 10-11-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
VERSION 17-1(52) 10-10-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
VERSION 17-1(51) 9-27-74 BY JFR FIX AUTHOR REASON STUFF
VERSION 17-1(50) 8-8-74 BY LDE BUG #TB# TYPO IN INPUT PREVENTED SETPL PAGENUM TO WORK
VERSION 17-1(49) 5-24-74
VERSION 17-1(48) 5-24-74
VERSION 17-1(47) 5-24-74 BY rht mode saibrk & saiprn to strser
VERSION 17-1(46) 5-24-74
VERSION 17-1(45) 5-24-74
VERSION 17-1(44) 5-24-74
VERSION 17-1(43) 5-24-74
VERSION 17-1(42) 5-24-74
VERSION 17-1(41) 5-24-74
VERSION 17-1(40) 5-19-74
VERSION 17-1(39) 5-19-74
VERSION 17-1(38) 5-19-74
VERSION 17-1(37) 5-19-74
VERSION 17-1(36) 5-5-74 BY RHT ADD $PRINT
VERSION 17-1(35) 5-5-74
VERSION 17-1(34) 5-5-74
VERSION 17-1(33) 5-5-74 BY JRL BUG #RX# (CMU =B7=) LDE SAYS SOSNUM,LINNUM,PAGNUM S/B INITIALIZED
VERSION 17-1(32) 3-26-74 BY RHT FEAT %AX% FINISH UP SETPL (POLISH IT LATER!!!)
VERSION 17-1(31) 3-26-74 BY RHT SOMEONE (ON 12 MARCH 1974) RAN SOS ON THIS FILE!
IF ANY TIME BOMBS WERE PLANTED, WE WILL FIND OUT!
VERSION 17-1(30) 2-22-74 BY RHT FEAT %BG% ADD BREAKSET MODE "F"
VERSION 17-1(29) 2-1-74 BY RHT BUG #QY# USBSTS NEEDED PATCHING
VERSION 17-1(28) 2-1-74
VERSION 17-1(27) 1-12-74 BY RHT MAKE COUNT RIGHT IN INOUT
VERSION 17-1(26) 1-12-74
VERSION 17-1(25) 1-12-74 BY RHT FIX COMPIL FOR SAITTY
VERSION 17-1(24) 1-11-74 BY RHT TTYINL STUFF
VERSION 17-1(23) 1-11-74 BY RHT MERGE IN CMU CHANGES
VERSION 17-1(22) 1-11-74
VERSION 17-1(21) 1-11-74
VERSION 17-1(20) 1-11-74
VERSION 17-1(19) 1-11-74
VERSION 17-1(18) 12-15-73 BY RFS FIX BUGS QC,QD.
VERSION 17-1(17) 12-10-73 BY JRL REMOVE LAST REFERENCES TO PGNNO
VERSION 17-1(16) 12-10-73
VERSION 17-1(15) 12-10-73
VERSION 17-1(14) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(13) 12-8-73 BY RFS MAKE ALTMODE 33 FOR EXPORT SYSTEMS
VERSION 17-1(12) 12-5-73 BY RHT BUG #PO#
VERSION 17-1(11) 12-5-73
VERSION 17-1(10) 12-5-73
VERSION 17-1(9) 12-3-73 BY RFS REMOVE ALL III DISPLAY STUFF
VERSION 17-1(8) 12-2-73 BY RHT FIX INPUT
VERSION 17-1(7) 12-2-73 BY RLS EDIT
VERSION 17-1(6) 12-2-73 BY RHT ALSO SOME WRD SPARES
VERSION 17-1(5) 12-2-73 BY RHT FEAT %AV% CHNCDB. ALSO SPARES ADDED TO OPN & BRK
VERSION 17-1(4) 12-2-73
VERSION 17-1(3) 12-1-73 BY RLS BUG #PM# DONT LOSE A CHAR IN INPUT
VERSION 17-1(2) 12-1-73 BY RLS ADD SETPL FUNCTION
VERSION 17-1(1) 7-27-73 BY JRL CHANGE OPEN TO FACT THAT RELEASE NOW TAKES TWO ARGUMENTS
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
VERSION 16-2(32) 8-14-72 BY RHT EVAL NOW NAMED APPLY
VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
VERSION 15-6(17-21) 5-4-72
VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
VERSION 15-6(7-16) 2-20-72
VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# (WD-ARRY)(IN-OUT) WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗Indices, Bits for IOSER ⊗
LSTON (IOSER)
IFN ALWAYS,<BEGIN IOSER>
DSCR IOSER -- IOSER GENERAL DISCUSSION
;SEE GOGOL FOR MORE DETAILS
; FORMAT OF CDBs
DMODE ←← 0 ;DATA MODE
DNAME ←← 1 ;DEVICE
BFHED ←← 2 ;HEADER POINTERS
OBPNT ←← 3 ;OUTPUT BUFFER POINTER
OBP ←← 4 ;OUTPUT BYTE POINTER
OCOWNT ←← 5 ;OUTPUT BYTE COUNT
ONAME ←← 6 ;OUTPUT FILE NAME -- FOR INFORMATION ONLY
OBUF ←← 7 ;OUTPUT BUFFER LOCATION
IBPNT ←←10 ;SAME STUFF FOR INPUT
IBP ←←11
ICOWNT ←←12
INAME ←←13
IBUF ←←14
ICOUNT ←←15 ;INPUT DATA COUNT LIMIT ADDRESS
BRCHAR ←←16 ;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
TTYDEV ←←16 ;LH -1 IF DEVICE IS A TTY -- USED BY OUT
ENDFL ←←17 ;INPUT END OF FILE FLAG ADDR
ERRTST ←←20 ;USER ERROR BITS SPECIFICATION WORD
LINNUM ←←21 ;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
PAGNUM ←←22 ;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
SOSNUM ←←23 ;ADDR OF SOS NUMBER WORD (SETPL FUNCTION)
; SIMIO INDICES
?IOSTATUS ←←0
?IOIN ←←1 ;SEE EXPLANATIONS IN SIMIO ROUTINE
?IODIN ←←2
?IOOUT ←←3
?IODOUT ←←4
?IOCLOSE ←←5
?IORELEASE ←←6
?IOINBUF ←←7
?IOOUTBUF ←←10
?IOSETI ←←11
?IOSETO ←←12
;;%##% A NEW GOODIE
?SETIOSTS ←←13
?IOOPEN ←←14
?IOLOOKUP ←←15
?IOENTER ←←16
?IORENAME ←←17
⊗
COMPIL(SIM,,,,,,DUMMYFORSCISS)
TYMSHR <
COMPXX(SIM,<SIMIO,CHNIOV,CHNIOR,CSERR,LPRYER>,<GOGTAB,X22,.SKIP.,DDFINA,INTRPT>
,<SIMIO,CSERR,LPRYER -- SUPPORT ROUTINES>)
>;TYMSHR
NOTYMSHR <
COMPXX(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
>;NOTYMSHR
COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗
DSCR SIMIO
CAL XCT INDEX,SIMIO
PAR AC field is index into instruction table (see below)
CHNL contains I/O channel number
other params can be gleaned from instruction table
RES an I/O instruction is executed. Routine skips if I/O instr did.
If the INDEX is LEQ 12, and if the instruction skips (error or EOF),
status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
can test it, or an error message is provided (depending on user-
enabling). This simplifies many I/O routines.
SID NONE
DES This routine makes I/O instructions re-entrant. The problem is
that the channel cannot be referenced indirectly.
⊗
↑↑SIMIO: PUSHJ P,.+1 ;SAVE PC OF XCT
PUSH P,C ;SAVE C
MOVE C,-1(P) ;ASSUME SKIP RETURN
LDB C,[POINT 4,-1(C),12] ;INDEX OF XCT
JUMPE C,USTST ;WANT STATUS BITS ONLY
CAIL C,13 ;NOW SPLIT HIGH AND LOW INDICES
JRST ALTIO ;SKIP RETURN CHECK ONLY
;;%##% CHECK TO NOT SCREW STANDARD DEC LOSERS
EXPO <
CAIN C,IOIN ;
JRST ISIOU ;
CAIE C,IOOUT ;IN OR OUT ?
JRST NOTIOU ;NOPE
ISIOU: SKIPG @USBTST(C) ;CHECK FOR NO BUFFERS (& MORE AT CMU)
JRST USFUNY ;NO BUFFERS, ETC.
>;EXPO
NOTIOU:MOVE C,IOINST(C) ;GET INSTRUCTION
TYMSHR <HLL CHNL,C
XCT IOINS2(C)>;TYMSHR
NOTYMSHR <
DPB CHNL,[POINT 4,C,12] ;CHANNEL NUMBER
XCT C ;DO OPERATION>;NOTYMSHR
JRST USOUT ;ALL KOSHER, NO EOF OR ERR
USTST: NOTYMSHR < MOVE C,[GETSTS C] ;WHA-
DPB CHNL,[POINT 4,C,12] ; T HAPPEN-
XCT C ; ED?>;NOTYMSHR
TYMSHR <HRLI CHNL,CIOGST
CHANIO CHNL,C>;TYMSHR
;;%##% SAVE STATUS BITS
MOVEM C,FSTATS(USER)
CMU <
USERF:
>;CMU
TRZ C,10000 ;IOACT BIT, USER LOOKUP CHECK BIT
HRLZM C,@ENDFL(CDB) ;GIVE USER THE BITS
TDNN C,ERRTST(CDB) ;ANY HE CAN'T HANDLE?
JUMPA CHNL,USSKIP ;NOPE, JUST SKIP-RETURN
;;%CQ% JFR 7-29-75 more information, please
;; ERR <I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
ERRSPL 1,[[ASCIZ /
I-O device error, channel @D status @B @F: @F @F/]
NOTYMSHR < PWORD CHNL ;CHANNEL #>;NOTYMSHR
TYMSHR < PRIGHT CHNL>;TYMSHR
PLEFT @ENDFL(CDB) ;STATUS BITS
PWORD DNAME(CDB) ;DEVICE
PWORD INAME(CDB) ;INPUT FILE NAME
PWORD ONAME(CDB)] ;OUTPUT FILE NAME
;;%CQ% ↑
USSKIP: AOS -1(P) ;SKIP-RETURN
USOUT: POP P,C ;RESTORE C
POPJ P, ;DONE
ALTIO: MOVE C,IOINST(C) ;GET INSTR
TYMSHR < HLL CHNL,C
XCT IOINS2(C)>;TYMSHR
NOTYMSHR <
DPB CHNL,[POINT 4,C,12]
XCT C ;DO IT>;NOTYMSHR
JRST USOUT ;NO SKIP
JRST USSKIP ;SKIP
EXPO <
USFUNY:
CMU < SKIPE @USBTST(C) ;FUNNY DEVICE?
JRST REALTM ; YES.
>;CMU
JUMP CHNL, ;FOR THE ERR MSG
ERR <NO BUFFERS ASSIGNED FOR I-O CHAN >,7
JRST USSKIP
CMU,< COMMENT ⊗ THIS NONSENSE IS A SPECIAL MODE FOR
THE CMU SPEECH DEVICES. ESSENTIALLY, IT DOES EVERTHING
AS NORMAL, EXCEPT THAT IT PICKS UP THE TIMING ERR AND
RUN-OUT-OF BUFFERS BIT OF THE
I/O STATUS FROM THE STATUS WORD IN THE BUFFER HEADER,
INSTEAD OF USING THE BIT FROM THE GETSTS. ⊗
TIMERR←←100000 ;TIMING ERR BIT FOR SPEECH DEVICES
ROBERR←←200000 ;RUN-OUT-OF-BUFFER ERR
REALTM: PUSH P,D ;NEED ANOTHER AC
CAIE C,IOIN ;INPUTTING?
JRST REALOT ; NO
MOVSI C,(<IN>)
DPB CHNL,[POINT 4,C,12] ;CHAN #
XCT C ;DO THE INPUT
JRST REALOK ;NO ERR, SO FAR
MOVE C,[GETSTS C]
DPB CHNL,[POINT 4,C,12] ;LOOKS FAMILIAR
XCT C
TRZA C,TIMERR!ROBERR ;TURN OFF THE ONES FROM THE GETSTS
REALOK: MOVEI C,0
HRRZ D,IBPNT(CDB) ;ADDRESS OF THE NEW BUFFER
IOR C,-1(D) ;THE BITS FROM THE BUFFER
REALRT: POP P,D ;RESTORE THE AC
TRNN C,760000 ;ERR OR EOF?
JRST USOUT ; NO
JRST USERF ; YES, GO LOOK AT IT
REALOT: MOVE C,[GETSTS C]
DPB CHNL,[POINT 4,C,12]
XCT C
TRNN C,ROBERR ;STOPPED FOR A ROB?
JRST REAL5 ; NO
HRRI D,(C) ;GET THE BITS
TRZ D,760000 ;TURN OFF THE ERRS
HRLI D,(<SETSTS>)
DPB CHNL,[POINT 4,D,12]
XCT D
REAL5: MOVSI D,(<OUT>)
DPB CHNL,[POINT 4,D,12]
XCT D
JRST REALRT
JRST REALRT ;IGNORE NOW, CATCH THE NEXT TIME THRU
>;CMU
USBTST←.-1
XWD CDB,IBUF ;1
;;#QY# ! RHT 2-1-74 NEEDED A DUMMY HERE.
777777 ;@ THRU THIS WILL BE ILL MEM REF
XWD CDB,OBUF ;3
>;EXPO
DSCR INSTRUCTION TABLE
⊗
IOINST←.-1 ;IOSTATUS ←← 0 GET STATUS
NOTYMSHR <
IN ;IOIN ←← 1 BUFFERED INPUT
IN D ;IODIN ←← 2 DUMP MODE INPUT
OUT ;IOOUT ←← 3 BUFFERED OUTPUT
OUT D ;IODOUT ←← 4 DUMP MODE OUTPUT
CLOSE (D) ;IOCLOSE ←← 5 CLOSE I,O, OR BOTH
;; ALLOW USE OF INHIBIT BITS IN RELEASE
RELEASE (D) ;IORELEASE←← 6
INBUF (A) ;IOINBUF ←← 7
OUTBUF (A) ;IOOUTBUF ←←10
USETI (A) ;IOSETI ←←11
USETO (A) ;IOSETO ←←12
;;%##% A NEW GOODIE
SETSTS (A) ; SET IO STATUS
OPEN DMODE(CDB) ;IOOPEN ←←14
LOOKUP FNAME(USER);IOLOOKUP←←15
ENTER FNAME(USER);IOENTER ←←16
RENAME FNAME(USER);IORENAME←←17>;NOTYMSHR
TYMSHR <
XWD CIOIN,0
XWD CIOIN,1 ;INDECIS ARE SAME AS ABOVE
XWD CIOOUT,0
XWD CIOOUT,1
XWD CIOCLS,2
XWD CIORLS,2
XWD CIOIBF,3
XWD CIOOBF,3
XWD CIOUSI,3
XWD CIOUSO,3
XWD CIOSTS,3
XWD CIOOPN,4
XWD CIOLUK,5
XWD CIOENT,5
XWD CIOREN,5
IOINS2: CHANIO CHNL,
CHANIO CHNL,D
CHANIO CHNL,(D)
CHANIO CHNL,(A)
CHANIO CHNL,DMODE(CDB)
CHANIO CHNL,FNAME(USER)>;TYMSHR
HACK <
;; ****** these two routines are badly misplaced
;; they ought to be removed from this compil someday
;; check with Bob Smith first, though
>;HACK
HERE(CSERR) MOVE USER,GOGTAB
POP P,UUO1(USER) ;STANDARD PLACE
ERR <CASE INDEX OVERFLOW, VALUE IS >,13
JRST @UUO1(USER) ;RETURN OK
HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
POPJ P,
TYMSHR <
COMMENT !
CHNIOV(CHANNEL,ARG,FUNCTION NUMBER)
CHNIOR IS SAME BUT ARG IS REFERENCE
IF FUNCTION NUMBER HAS BITS IN LEFT HAF FOR CALL BY
VALUE, ITS FOR AN "IMMEDIATE" TYPE INSTR LIKE SETSTS
BOTH FUCNTIONS RETURN A VALUE BUT IT HAS MEANING ONLY
IN SOME CASES (DEPENDS ON FUNCTION).
SETS .SKIP.
!
HEREFK(CHNIOV,CHNCV.)
POP P,1 ;RETURN ADDRESS
EXCH 1,-1(P) ;NOW ITS ARGUMENT
MOVE 2,[CHANIO 3,1]
CHNCLC: POP P,3 ;FUNCTION
TLNE 3,-1
HRR 2,1 ;FOR IMMEDIATE
SETOM .SKIP.
HRL 3,-1(P) ;CHANNEL NUMBER
MOVSS 3 ;CHANNEL IS IN LEFT HALF
SKIPE INTRPT
XCT DDFINA
XCT 2
SETZM .SKIP.
SUB P,X22
JRST @2(P)
HEREFK(CHNIOR,CHNCR.)
POP P,2
EXCH 2,-1(P) ;NOW ITS PARAMETER ADDRESS
MOVE 1,2 ;IN CASE FUNCTION WITH BITS IN LH
HRLI 2,(<CHANIO 3,>)
JRST CHNCLC
>;TYMSHR
ENDCOM(SIM)
COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
COMMENT ⊗Getchn ⊗
DSCR Getchn, Getchan
PAR A -- addr of ASCII for routine name
CHNL -- I/O channel number from SAIL call
RES -- CHNL contains actual I/O channel number (diff for shared TTY)
CDB contains ptr to actual CDB table for that channel
SID A(lh) is changed
DES normally just sets up CHNL and CDB
if error occurs (channel out of bounds, already open), a fatal message
is printed, using the address in A to get the routine name.
This routine is called by most I/O routines, having saved ACs and
fetched CHNL.
⊗
GETCHN:
HRLI A,(<PUUO 3,0>) ;PREPARE FOR ERR MESS
TRZE CHNL,777760 ;CHECK FOR VALID CHANNEL NO
JRST NOTVALID ;INVALID CHANNEL NUMBER
SKIPE CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
POPJ P,
NOTOPN:
XCT A ;PRINT ROUTINE NAME
ERR <: CHANNEL OR FILE NOT OPEN>
NOTVALID:
XCT A ;ROUTINE NAME
ERR <: CHANNEL NUMBER INVALID>
DSCR INTEGER←GETCHAN;
CAL SAIL
⊗
HERE (GETCHAN)
MOVE USER,GOGTAB
ADD USER,[XWD A,CHANS] ;MAKE @ WORD
MOVEI A,1 ;START AT CHANNEL 1
CHLUP: SKIPN @USER ;IF CHANNEL IS FREE,
POPJ P, ; RETURN
CAIGE A,17 ;CYCLE TO 0?
AOJA A,CHLUP ;NO, TRY NEXT
MOVEI A,0 ;TRY 0
SKIPE @USER ;FREE?
HRROI A,-1 ;NOPE
POPJ P, ;DONE
ENDCOM(CHN)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗
DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
EXT(USER): SIXBIT /extension,,0/
0
PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
***** SKIP RETURNS IF SUCCESSFUL *****
⊗
↑↑FILNAM:
SUB SP,X22 ;ADJUST STACK
FOR II←1,3 <
SETZM FNAME+II(USER)>
MOVEI X,FNAME(USER) ;WHERE TO PUT IT
PUSHJ P,FLSCAN ;GET FILE NAME
TYMSHR < CAIE Y,"("
JRST CHKEXT ;NOT USER NAME
SETZM FUSER(USER)
SETZM FUSER1(USER)
HRRZS 1(SP)
MOVEI D,12 ;12 CHRS MAX
MOVEI X,FUSER(USER)
PUSHJ P,FLSCAN+2
CAIE Y,")"
JRST FLERR ;NOT DELIMITED PROPERLY
MOVEI X,FUSER(USER)
HRRZM X,FNAME+3(USER) ;STORE POINTER
MOVEI X,FNAME(USER)
PUSHJ P,FLSCAN
CHKEXT:
>; TYMSHR
JUMPE Y,FLDUN ;FILE NAME ONLY
CAIE Y,"." ;EXTENSION?
JRST FLEXT ;NO, CHECK PPN
MOVEI X,FNAME+1(USER)
PUSHJ P,FLSCAN
FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
CAIE Y,"["
JRST FLERR ;INVALID CHARACTER
CMU < ;HANDLE PPNS VIA UUO, MAYBE
HRRZS 1(SP) ;LENGTH PART
;SNEAK A LOOK AT FIRST CHAR
SKIPN 1(SP) ;IS THERE A FIRST CHAR?
JRST FLERR ; NO.
MOVE X,2(SP)
ILDB X,X
;;=C4= 1 of several LDE 28-Jun-74 allow null ppn within [].
CAIN X,"]" ;is it null?
JRST OCTPPN ; yes -- let the other guy handle it.
;;
CAIL X,"0"
CAILE X,"7"
SKIPA ; NOT OCTAL DIGIT
JRST OCTPPN
PUSH P,A ;NEED MORE ROOM
PUSH P,B
SETZM A ;CLEAR THE AREA
SETZM B
SETZM C
MOVEI D,=13+1 ;MAX #CHARS+1
MOVE X,[POINT 7,A] ;DUMP THEM THERE
FLN2: SOSGE 1(SP)
JRST FLERRC ;RAN OUT OF STRING
ILDB Y,2(SP) ;THE NEXT CHAR
;;=C4= 2 OF SEVERAL
JUMPE Y,FLN2 ;IGNORE NULLS
;;
CAIN Y,"]" ;THE END?
JRST GOTRB ; YES
JUMPLE D,FLERRC ;WE DON'T WANT ANY MORE CHARACTERS
IDPB Y,X ;STICK THE CHAR THERE
SOJA D,FLN2 ;GET ANOTHER
GOTRB: MOVEI X,A ;THATS WHERE THE UUO WILL FIND THEM
CALLI X,-2 ;CMUDEC UUO
JRST FLERRC ;SOMETHING WRONG
MOVEM X,FNAME+3(USER) ;SAVE IT
AOS -2(P) ;INDICATE SUCCESS
FLERRC: POP P,B
POP P,A
POPJ P,
OCTPPN:
>;CMU
TYMSHR < SKIPE FNAME+3(USER) ;IGNORE IF USER NAME
JRST FLDUN ;TREAT AS DONE
>;TYMSHR
PUSHJ P,[
RJUST: SETZM PROJ(USER)
MOVEI X,PROJ(USER)
PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
MOVE X,PROJ(USER)
IMULI D,-6 ;SHIFT FACTOR
LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
IFE SIXSW,<
MOVEI X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
;;=C4= 3 OF several LE03 28-JUN-74 ALLOW NULL PPN
; MOVE D,PROJ(USER) ;WAS A HLLZ
SKIPN D,PROJ(USER)
POPJ P,
;;
;;
FBACK: MOVEI C,0
LSHC C,6 ;GET A SIXBIT CHAR
CAIL C,'0'
CAILE C,'7'
JRST FLERR ;INVALID OCTAL
LSH X,3
IORI X,-'0'(C)
JUMPN D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
FPOP: POPJ P,]
HRLZM X,FNAME+3(USER)
CAIE Y,","
;;=C4 4 OF several
; JRST FLERR ;INVALID CHAR
JRST [JUMPE X,FLDUN1 ;ALLOW NULL PPN - CHECK FOR "]"
JRST FLERR] ;A REAL ERROR.
;;
DEC<
IFE ALWAYS,<EXTERN MYPPN>
;;=I09= FOR SFD, IF NULL ARG, TAKE FROM OUR PPN
JUMPN X,.+3 ;IF NULL FIRST HALF,
MOVE X,MYPPN ;USE OUR PPN INSTEAD
HLLM X,FNAME+3(USER)
>;DEC
PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
DEC<
JUMPN X,.+2
MOVE X,MYPPN ;IF NULL SECOND HALF, USE OUR PPN
>;DEC
HRRM X,FNAME+3(USER)
;;=C4= 5 OF several.
FLDUN1:
;;
;;%DP% ! JFR 8-13-76 by popular demand, allows trailing ] to be omitted
;; CAIN Y,"]"
;;=I09= 3 OF MANY
SFDS<
CAIN Y,"]"
JRST FLDUN ;IF ], OK
CAIE Y,"," ;IF "," MUST BE SFD COMING
JRST FLERR ;IF NEITHER, ERROR
SETZM PATHBL(USER) ;INIT PATHBLOCK
SETZM PATHBL+1(USER)
MOVE C,PRPN(USER) ;GET PPN AND PUT IN PATH BLOCK
MOVEM C,PATHBL+2(USER)
MOVEI C,PATHBL(USER) ;AND PUT PTR TO PATH BLOCK IN PPN
MOVEM C,PRPN(USER)
MOVEI X,PATHBL+3(USER) ;FIRST SFD PLACE
MOVEI C,SFDLVL ;COUNTER - SFDLVL IS MAX NO. OF SFDS
FLSFD: PUSHJ P,FLSCAN ;GET SFD NAME
CAIN Y,"]" ;IF LAST ONE
JRST FLSFD1 ;FINISHED
MOVEI X,1(X) ;OTHERWISE LOOK AT NEXT
CAIN Y,","
SOJG C,FLSFD ;UNLESS TOO MANY
JRST FLERR ;WHICH IS ERROR
FLSFD1: SETZM 1(X) ;PUT ZERO AT END OF PATH BLOCK
> ;SFDS
FLDUN: AOS (P) ;SUCCESSFUL
FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗
DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
break (punctuation) char in Y (0 if string exhausted)
D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗
↑↑FLSCAN:
HRRZS 1(SP) ;WANT ONLY LENGTH PART
MOVEI D,6 ;MAX NUMBER PICKED UP
SETZM (X) ;ZERO DESTINATION
HRLI X,440600 ;BYTE POINTER NOW
;; \UR#25\ JRL 6/20/78 ALLOW OCTAL DIGITS AS FILE NAMES
; Wish to allow #oooooooooooo as file name (where each o is an
; octal digit). Main reason is to allow SAIL programs to deal
; with funny filenames such as UFD's.
MOVEI Y,0 ; BREAK CHAR IN CASE NO STRING
SOSGE 1(SP) ; DECREMENT STRING LENGTH
POPJ P, ; NO STRING, RETURN
ILDB Y,2(SP) ; PICK UP CHAR
CAIE Y,"#" ; IS THIS AN OCTAL FILE NAME?
JRST URNOCT ; NOPE, HANDLE NORMAL WAY.
PUSH P,X ; SAVE ADDRESS TO PLACE ANSWER
MOVEI D,=12 ; OCTAL NAME MAY HAVE 12 DIGITS
MOVEI X,0 ; ACCUMULATE ANSWER IN X
URFLN1: MOVEI Y,0 ; BREAK CHAR IF STRING EXHAUSTED
SOSGE 1(SP) ;
JRST URFRET ; STRING EXHAUSTED, RETURN
ILDB Y,2(SP) ; PICK UP CHAR
CAIE Y,"." ; SEE IF BREAK CHARACTER.
CAIN Y,"[" ;
JRST URFRET ;
CAIE Y,"]" ;
CAIN Y,"," ;
JRST URFRET
; NOT A BREAK CHARACTER. SEE IF DIGIT. IF NOT IGNORE IT.
JUMPE D,URFLN1 ; ALREADY HAVE 12 DIGITS?
CAIG Y,"7" ; CHECK TO SEE IF DIGIT
CAIGE Y,"0"
JRST URFLN1 ; NOT DIGIT. IGNORE
ANDI Y,7 ; GET VALUE OF DIGIT.
LSH X,3 ; ACCUMULATE DIGITS
ORI X,(Y)
SOJA D,URFLN1 ; LOOP
URFRET: MOVEM X,@(P) ; STORE ANSWER
POP P,X ; CLEAN-UP STACK
POPJ P, ; RETURN
FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
SOSGE 1(SP) ;TEST 0-LENGTH STRING
POPJ P,
ILDB Y,2(SP) ;GET BYTE
URNOCT: ; NOT AN OCTAL FILE NAME
;; \UR#25\ END OF #OCTAL DIGIT FILE NAME HACK CHANGES
TYMSHR < CAIE Y,"("
CAIN Y,")"
POPJ P,
>;TYMSHR
CAIE Y,"." ;CHECK VALID BREAK CHAR
CAIN Y,"["
POPJ P,
CAIE Y,"]"
CAIN Y,","
POPJ P,
JUMPE D,FLN1 ;NEED NO MORE CHARS
;;=C4= 6 of several. IGNORE NULL CHARACTERS.
JUMPE Y,FLN2X
TYMSHR < CAIGE Y,40
JRST FLN2>;TYMSHR
;;
TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
TRZA Y,40 ; TO CONVERT TO SIXBIT
TRO Y,40 ; (NO CHECKING)
IDPB Y,X ;PUT IT AWAY
;;=C4= 7 of several
FLN2X:
;;
SOJA D,FLN1 ;CONTINUE
TYMSHR< FLN2: MOVEI Y,0
SOSGE 1(SP)
FLN3: POPJ P,
ILDB Y,2(SP) ;JUST GET SOME CHRS
SOJL D,FLN3 ;RETURN IF DONE
TRZN Y,100
TRZA Y,40
TRO Y,40
IDPB Y,X
JRST FLN2>;TYMSHR
ENDCOM(FLS)
COMPIL(OPN,<OPEN,RELEASE,SETPL,CHNCDB>
,<GETCHN,SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
,<OPEN RELEASE AND SETPL FUNCTIONS>)
COMMENT ⊗Open ⊗
DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
CAL SAIL
⊗
COMMENT ⊗
Allocate IBFS input and OBFS output buffers on channel CHAN for
device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF
addresses in a newly allocated CDB (channel data block). Store
all necessary information to carry out I/O on this channel
in the CDB. Mark the channel open.
⊗
.OPN:
HERE (OPEN)
; FIRST RELEASE IF ALREADY OPEN
PUSH P,-7(P)
; RELEAS NOW TAKES TWO ARGS
PUSH P,[0]
PUSHJ P,RELEASE ;SIMPLE
; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB
PUSHJ P,SAVE ;SAVE ACS
MOVEI C,IOTLEN ;SIZE
PUSHJ P,CORGET ;OBTAIN A BLOCK
JRST BADOPN ;CAN'T GET IT
MOVE CDB,B ;CDB ptr to CHANNEL TABLE
;;#WZ# JFR 6-17-76 ZERO OUT THE WHOLE THING. SUPERSEDES #RX# (CMU =B7=)
SETZB LPSA,(CDB) ;NOW GET READY IN CASE OF ERROR
MOVSI TEMP,(CDB)
HRRI TEMP,1(CDB)
BLT TEMP,IOTLEN-1(CDB)
;;#WZ# ↑
SUB SP,X22
; FILL IT WITH NON-CONTROVERSIAL THINGS
POP P,TEMP ;RETURN ADDRESS
POP P,ENDFL(CDB) ;END OF FILE FLAG ADDRESS
POP P,BRCHAR(CDB) ;BREAK CHAR ADDRESS
POP P,ICOUNT(CDB) ;INPUT COUNT ADDRESS
POP P,OBUF(CDB) ;NUMBER OF OUTPUT BUFFERS
POP P,IBUF(CDB) ;NUMBER OF INPUT BUFFERS
POP P,Z ;DATA MODE
POP P,CHNL ;DATA CHANNEL
CHKCHN CHNL,<OPEN> ;ASSURE VALID
;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
;; AVOID REFERENCES TO PGNNO, WHICH IS same as ERRTST!
HRRZI X,750000 ;ERROR BITS POSSIBLY ENABLED -- WAS A HRROI
;;#HA#
ANDCM X,Z ;ERROR BITS ACTUALLY ENABLED ARE 0
MOVEM X,ERRTST(CDB) ;SAVE ENABLATIONS
TRZ Z,750000 ;REMOVE IRRELEVANT BITS
ILLMOD ←← 777777
DEC<ILLMOD←←007777
>;DEC
CMU <
ILLMOD ←← 377776 ;BIT 400000 FOR SPECIAL DEVICE (CMU)
;BIT 000001 FOR KEEPING NULLS
TLZE Z,10000 ;IOACTIVE BIT TO BE SET ON OPEN ??? (LDE)
TRO Z,10000 ;YES
>;CMU
TLNE Z,ILLMOD ;CHECK VALIDITY SOMEWHAT
ERR <OPEN: INVALID DATA MODE>,1
MOVEM Z,DMODE(CDB) ;STORE MODE
; GET DEVICE NAME
MOVEI X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
PUSHJ P,FLSCAN ;GET DEVICE NAME
;;%##% ONLY GIVE ERROR MESSAGE IF NOT ASKED NOT TO
JUMPN Y,[
SKIPN @ENDFL(CDB) ;FLAGGED??
ERR <INVALID DEVICE NAME FOR OPEN>,1
JRST .+1
]
;IF TTY, MARK TTYDEV FOR OUT
HLRZ TEMP,DNAME(CDB) ;GET LH DEVICE NAME
MOVSI Z,400000 ;BIT TO MARK WITH
;;%##% DO A DEVCHR NOW
;; CAIE TEMP,'TTY' ;IF TTY OR PTY,
CAIN TEMP,'PTY' ; ,
JRST MRKTYB ;MARK AS A TTY
MOVE TEMP,DNAME(CDB) ;PICK UP DEVICE AGAIN (FULL SIXBIT)
CALL6 (TEMP,DEVCHR) ;GET CHARACTERISTICS
TLNE TEMP,10 ;A TTY???
MRKTYB: IORM Z,TTYDEV(CDB); IT'S A TTY
;;%##%
; NOW SET HEADER PTRS IN CDB
HRRZI Z,-1 ;TO TEST RIGHT HALF
SETZM BFHED(CDB) ;CLEAR HEADER POINTER
LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
CAIL E,15 ;DUMP MODE?
JRST AGNN ; YES, NO BUFFER HEADER WORD
MOVEI TEMP,OBPNT(CDB) ;IF OUTPUT, SET POINTER
TDNE Z,OBUF(CDB) ;ANY OUTPUT BUFFERS?
HRLM TEMP,BFHED(CDB)
MOVEI TEMP,IBPNT(CDB) ;SAME FOR INPUT
TDNE Z,IBUF(CDB) ;ANY INPUT BUFFERS?
HRRM TEMP,BFHED(CDB)
; NOW OPEN THE FILE, GET THE BUFFERS,ETC.
AGNN: XCT IOOPEN,SIMIO ; OPEN CHAN,MODE
JRST [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
JRST NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
JRST RTRY]
COMMENT ⊗
ERMAN'S IMPROVED BUFFER GETTER --- DEC. 1970
If a buffer size is specified (lh #buf word), allocate that size, else the
standard size (determined via a dummy XXXBUF, clever soul that LDE is).
"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
⊗
MOVEI Z,0 ;FOR DUMMY (AND REAL) OUTBUF
PUSHJ P,GETBFS ;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
ADDI CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
MOVEI Z,-1
PUSHJ P,GETBFS ;GET CORE, DO INBUFS
SUBI CDB,OBUF-OBPNT+1;RE-RELOCATE
CMU < ;FUNNY INPUT DEVICE
SKIPL DMODE(CDB) ;DID HE SPECIFY TO GET ERRS FROM
; BUFFER HEADER?
JRST STNIT ; NO.
HRLZI TEMP,400000
SKIPE IBUF(CDB) ;INPUT BUFFERS?
JRST [IORM TEMP,IBUF(CDB) ; YES
JRST STNIT]
SKIPE OBUF(CDB) ;OR OUTPUT BUFFERS?
JUMPA CHNL,[IORM TEMP,OBUF(CDB) ; YES
JRST STNIT]
ERR<OPEN: SPEECH DEV BUT NO BUFFERS, CHAN >,7
>;CMU
; FINISH OUT -- SET EOF FLAG IF DESIRED
STNIT: ;SETOM JOBFF ;ONE MUST KNOW WHAT HE IS DOING TO USE
MOVEM CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
SETZM @ENDFL(CDB) ;MARK OPEN SUCCESSFUL
JRST RESTR ;RESTORE ACS, RETURN
BADOPN: HRRZ TEMP,JOBREN ;NEXT START WILL ASK ALLOC
HRRM TEMP,JOBSA ;QUESTION
ERR <TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>
RTRY: TERPRI <OPEN: DEVICE NOT AVAILABLE>
TERPRI <TYPE "R" TO RETRY, "X" TO GO ON WITHOUT>
PRINT <?>
PUUO TEMP
CAIE TEMP,"r"
CAIN TEMP,"R" ;TRY AGAIN?
JRST AGNN ;YES
;;%##%
SETOM @ENDFL(CDB) ;MARK A LOSER
JRST NORELO
;;%##%
GETBFS: SETZM ONAME(CDB) ;CLEAR FILE NAME
HRRZ Y,OBUF(CDB) ;NUMBER OF BUFFERS
HLRZ D,OBUF(CDB) ;SIZE
EXPO <
HRRZS OBUF(CDB) ;MARK FOR SPECIAL TEST
>;EXPO
JUMPE Y,GBUFRT ;NO BUFFERS
JUMPE D,GETDES ;WANTS DEFAULT SIZE
NOTYMSHR< ANDI D,7777 ;MAX BUFFER SIZE>;NOTYMSHR
TYMSHR<ANDI D,37777>;TYMSHR
HRLZ A,D ;SIZE IN LH
PUSHJ P,GETCOR ;GET THE CORE (SURPRISE!)
SETZM OCOWNT(CDB) ;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
CAIL E,15 ;DUMP MODE?
JRST GBUFRT ; YES, DON'T ACTUALLY FUDGE UP BUFFERS
NOEXPO <;USE UINBF, UOUTBF
;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
MOVEM B,JOBFF ;B FROM CORGET HAS BUFFER AREA ADDRESS
SUBI D,2 ;GETCOR INCREMENTED
;;#GD#
HRRZ C,Y
MOVE A,[UINBF C]
JUMPN Z,.+2
MOVE A,[UOUTBF C]
DPB CHNL,[POINT 4,A,12]
;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
XCT A ;DO THE ALLOCATIONS
;;#GD#
POPJ P,
>;NOEXPO
EXPO <
ADDI B,1 ;SECOND WORD
BUFC1: HRR A,B
SOJLE Y,BUFC2
ADD B,D ;NEXT ONE
MOVEM A,(B) ;MAKE POINT TO PREV
JRST BUFC1
BUFC2: MOVE B,OBUF(CDB) ;BACK TO FIRST
MOVEM A,1(B) ;LINK IT TOO
HRLI A,400000 ;RING-USE BIQ
MOVEM A,OBPNT(CDB) ;BUFFER PTR
POPJ P,
>;EXPO
GETCOR: ADDI D,2 ;+2 FOR ACCOUNTING
MOVE C,D
IMUL C,Y ;TOTAL CORE NEEDED
PUSHJ P,CORGET ;GRAB IT
ERR <OPEN: NOT ENUFF CORE FOR BUFFERS>
HRRZM B,OBUF(CDB) ;SAVE SO CAN RELEASE
POPJ P,
GETDES: MOVEI A,1 ;1 DUMMY BUFFER
CAIL E,15 ;GOOD OLD DUMP MODE?
JRST [MOVEI D,202 ;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
JRST GDIT] ; WORK IN DUMP MODE
;;#VE# UGLY CODE REPLACED BY DIFFERENT UGLY CODE
; MOVEI TEMP,BRKDUM-1(USER)
; MOVEM TEMP,JOBFF
PUSH P,[0] ;
HRRZM P,JOBFF ;
PUSH P,[0] ;MOST LIKEYL ONLY ONE PUSH IS ENOUGH, BUT ...
PUSH P,[0] ;
PUSHJ P,GETIOB ;DUMMY IN/OUBUF
LDB D,[POINT 17,-1(P),17] ;GET THE SIZE
SUB P,X33 ;POP BACK
;;#VE# ↑↑
GDIT: PUSHJ P,GETCOR ;GET THE CORE
SETZM OCOWNT(CDB) ;CLEAR BYTE COUNT
CAIL E,15 ;DUMP MODE?
JRST GBUFRT ;YES, NO BUFFER STRUCTURE
MOVEM B,JOBFF
MOVE A,Y ;NUMBER OF BUFFERS
PUSHJ P,GETIOB ;NOW FOR REAL
GBUFRT: SETOM JOBFF ;FOR SPITE
POPJ P,
GETIOB: SKIPN Z
XCT IOOUTBUF,SIMIO ;DO OUTBUF
SKIPE Z
XCT IOINBUF,SIMIO ;INBUF
POPJ P,
SUBTTL RELEASE
COMMENT ⊗Release ⊗
DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
CAL SAIL
DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
⊗
COMMENT ⊗
Release channel, i/o buffers, channel table if channel is open
Adjust special TTY stuff to reflect lossage if TTY channel
⊗
HERE(RELEASE)
.RELS:
SETOM JOBFF ;MARK INVALID
PUSHJ P,SAVE ;SAVE REGS, GET USER, SAVE RETURN
;; FOLLOWING WAS MOVE LPSA,X22
MOVE LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
MOVE CHNL,-2(P) ;CHANNEL #
CHKCHN CHNL,<RELEASE> ;VALIDATE
SKIPN CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
JRST RESTR ;CHANNEL NOT OPEN, FORGET IT
SETZM @CDBLOC(USER) ;CLEAR CHANS TABLE ENTRY
;; INHIBIT BITS;
HRRZ D,-1(P) ;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
XCT IORELEASE,SIMIO ;RELEASE CHAN,0
HRRZ B,IBUF(CDB) ;RELEASE ANY INPUT
PUSHJ P,BUFREL ; BUFFERS
HRRZ B,OBUF(CDB) ;ALSO OUTPUT
PUSHJ P,BUFREL ; BUFFERS
NORELO: HRRZ B,CDB ;WHERE TO RELEASE
PUSHJ P,CORREL ;GIVE CDB BACK
JRST RESTR ;RESTORE AND RETURN
BUFREL: JUMPN B,CORREL ;RELEASE IF ANY TO RELEASE
POPJ P, ;ELSE RETURN
DSCR SETPL(CHANNEL,@LINNUM,@PAGNUM,@SOSNUM)
CAL SAIL
⊗
HERE(SETPL)
PUSHJ P,SAVE
MOVE CHNL,-4(P) ;GET CHANNEL
PUSHJ P,GETCHN ;VALIDATE, LOAD CDB
POP P,TEMP ;RETURN ADDRESS (GET OUT OF WAY)
POP P,SOSNUM(CDB)
SETZM @SOSNUM(CDB)
POP P,PAGNUM(CDB)
SETZM @PAGNUM(CDB)
POP P,LINNUM(CDB) ;LINE NUMBER
SETZM @LINNUM(CDB)
MOVE LPSA,X11 ;REMOVE CHANNEL NUMBER FROM STACK
JRST RESTR
;;%AV% -- rht
DSCR CHNCDB(CHANNEL);
CAL SAIL
DES RETURNS INTEGER = INPHDR,,OUTHDR
(ACTUALLY COULD BE GOTTEN FROM CDB BY USER, BUT THIS
PROMISSES MORE STABILITY)
⊗
HERE(CHNCDB)
PUSHJ P,SAVE ;
MOVE CHNL,-1(P) ;GET CHANNEL NUMBER
PUSHJ P,GETCHN ;CHECK & LOAD CDB
MOVEI 1,DMODE(CDB) ;GET VALUE
MOVEM 1,RACS+1(USER) ;SO RESTR WINS
MOVE LPSA,X22 ;
JRST RESTR ;RETURN
HERE(OPNSP1) ;PERHAPS PUT GETSTS HERE
;;%##% GOBBLED DOWN TWO SPARE HERES HERE FOR STATUS ROUTINES THAT FOLLOW
ERR <DRYROT IN OPEN SPARES>
ENDCOM (OPN)
;;%##%
COMPIL(STS,<GETSTS,SETSTS>
,<SAVE,RESTR,SIMIO,GOGTAB,GETCHN,X11,X33,X22>
,<GETSTS AND SETSTS>)
COMMENT ⊗GETSTS,SETSTS⊗
DSCR STATUS←GETSTS(CHANNEL);
CAL SAIL
⊗
.STS:
HERE(GETSTS)
PUSHJ P,SAVE
LOADI7 A,<GETSTS>
MOVE CHNL,-1(P) ;CHANNEL #
PUSHJ P,GETCHN
XCT IOSTATUS,SIMIO ;DO THE UUO
JFCL
MOVE A,FSTATS(USER) ;THE RESULT
MOVEM A,RACS+A(USER) ;SO RESTR WORKS
MOVE LPSA,X22
JRST RESTR
DSCR SETSTS(CHANNEL,STATURS);
CAL SAIL
⊗
HERE(SETSTS)
PUSHJ P,SAVE
LOADI7 A,<SETSTS>
MOVE CHNL,-2(P)
PUSHJ P,GETCHN
MOVE A,-1(P) ;INTENDED STATUS BITS
XCT SETIOSTS,SIMIO ;XECUTE THE INST
JFCL ;SHOULDN'T SKIP
MOVE LPSA,X33
JRST RESTR ;GO RESTORE
ENDCOM(STS)
COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
COMMENT ⊗Lookup, Enter ⊗
DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗
Comment ⊗
LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
a format acceptable to FILNAM above. If successful,
FAILURE!FLAG (called by reference) is zeroed. It is
otherwise set to -1 in LH, error code in RH.
⊗
.LOK:
HERE (LOOKUP) PUSHJ P,SAVE
LOADI7 A,<LOOKUP>
PUSH P,[XCT IOLOOKUP,SIMIO] ;LOOKUP CH,FILE
MOVEI B,INAME ;TO STORE FILE NAME
JRST LOKENT ;DO THE OPERATION
DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗
HERE (ENTER)
PUSHJ P,SAVE
LOADI7 A,<ENTER>
PUSH P,[XCT IOENTER,SIMIO] ;ENTER CH,FILE
MOVEI B,ONAME ;TO STORE FILE NAME
LOKENT:
MOVE LPSA,X33 ;PARAM ADJUST FOR RESTR
MOVE CHNL,-3(P) ;GET CHANNEL #
PUSHJ P,GETCHN ;VALIDATE
SETZM @-2(P) ;ASSUME SUCCESS
PUSHJ P,FILNAM ;GET FILE
JRST BADSPC ; NO GOOD, REPORT ERROR
ADD B,CDB ;ADDR OF FILE NAME HOLDER
MOVEW (<(B)>,<FNAME(USER)>) ;STORE IT
TYMSHR < MOVEI X,5 ;SPECIAL LOOKUP HERE
EXCH X,FNAME(USER)
EXCH X,FNAME+2(USER)
MOVEM X,FNAME+4(USER)
MOVE X,FNAME+3(USER)
EXCH X,FNAME+1(USER)
MOVEM X,FNAME+3(USER)>;TYMSHR
POP P,X ;INSTRUCTION TO DO
MOVE Y,[JRST ELERR] ;FAILURE
NOTYMSHR < MOVE Z,[JRST RESTR] ;SUCCESS>;NOTYMSHR
TYMSHR < MOVE Z,[JRST LOKNT1] ;SUCCESS>;TYMSHR
ENF1: JRST X ;ENTER/LOOKUP
BADSPC: POP P,(P) ;REMOVE IO INSTRUCTION
HRRZ TEMP,ERRTST(CDB) ;GET USER-ENABLE BITS
TRNE TEMP,10000 ;ENABLED FOR HANDLING BAD FILE SPECS?
ERR <LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
SKIPA TEMP,[=8] ;ALWAYS REPORT NO GOOD LOOKUP/ENTER
ELERR: TYMSHR <PUSHJ P,LOKNTC>;TYMSHR
NOTYMSHR< HRRZ TEMP,FNAME+1(USER) ;WHY DID IT BLOW?>;NOTYMSHR
HRROM TEMP,@-1(P) ;TELL THE USER
JRST RESTR
TYMSHR <
LOKNTC: MOVE TEMP,FNAME+4(USER)
EXCH TEMP,FNAME+2(USER) ;PUT THINGS BACK
MOVEM TEMP,FNAME(USER)
MOVE TEMP,FNAME+1(USER)
EXCH TEMP,FNAME+3(USER)
MOVEM TEMP,FNAME+1(USER)
POPJ P,
LOKNT1: PUSHJ P,LOKNTC
JRST RESTR>;TYMSHR
COMMENT ⊗Fileinfo ⊗
DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
CAL SAIL
⊗
Comment ⊗ This routine gives the user the entire 6 word block
from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗
HERE (FILEINFO)
MOVE USER,GOGTAB
POP P,UUO1(USER) ;GET RID OF IT, MARK LAST SAIL CALL
POP P,LPSA ;ARRAY ADDRESS WHERE INFO IS TO GO
SKIPGE -2(LPSA) ;MAKE SURE IT'S NOT A STRING ARRAY
ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
MOVE TEMP,-1(LPSA) ;TOTAL ARRAY SIZE WORD
CAML TEMP,[XWD 1,6] ;MUST BE 1-D, AT LEAST 6 WORDS
CAMLE TEMP,[XWD 1,-1] ;BUT NOT 2-D
ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
MOVEI TEMP,5(LPSA) ;BLT TERMINATOR
HRLI LPSA,FNAME(USER) ;SOURCE OF VALUABLE INFORMATION
BLT LPSA,(TEMP) ;GIVE!
JRST @UUO1(USER) ;GONE
ENDCOM (LOK)
COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
,<STRING OUTPUT ROUTINE>)
COMMENT ⊗Out ⊗
DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY ⊗
.OUT.:
HERE (OUT) PUSHJ P,SAVE ;ACS, GET USER, SAVE RETURN FOR ERROR
MOVE LPSA,X22
MOVE CHNL,-1(P) ;CHANNEL NUMBER
LOADI7 A,<OUT>
PUSHJ P,GETCHN ;VALIDATE AND GET CDB, ETC.
HRRE Z,-1(SP) ;#CHARS
POP SP,D
SUB SP,X11
;;#WZ# JFR 6-17-76 TRAP OUT WITH NO PLACE TO PUT STRING
SKIPN B,OBP(CDB)
JRST [ERRSPL 1,[[ASCIZ/
OUT: No buffer. Channel @D file @F: @F @F/]
PWORD CHNL
PWORD DNAME(CDB)
PWORD INAME(CDB)
PWORD ONAME(CDB)]
JRST RESTR]
;;#WZ# ↑
MOVE A,OCOWNT(CDB)
JRST .OUT1
;; \UR#23\ (1 of 2) JRL 5/2/78 following used to be SOJLE
;; (would have caused buffer to be written out too early
;; except for compensating error below).
.OUT: SOJL A,OUT1 ;NEED OUTPUT??
.OUT2: ILDB X,D ;GET A CHAR
IDPB X,B ;PUT IT AWAY
.OUT1: SOJGE Z,.OUT ;LOOP
OUTDUN: MOVEM B,OBP(CDB) ;PUT BP AWAY
MOVEM A,OCOWNT(CDB) ;COUNT AWAY
SKIPGE TTYDEV(CDB) ;TTY?
XCT IOOUT,SIMIO ; YES, FORCE OUTPUT
JRST RESTR
JRST RESTR
OUT1: LDB TEMP,[POINT 4,DMODE(CDB),35] ;MODE
CAIL TEMP,15 ;DUMP?
JRST DMPO ;YES
MOVEM B,OBP(CDB) ;PUT REAL BP AWAY
XCT IOOUT,SIMIO ;DO THE OUTPUT
JFCL ;ERRORS HANDLED IN SIMIO
MOVE B,OBP(CDB) ;NEW BP
MOVE A,OCOWNT(CDB) ;NEW COUNT
;; \UR#23\ (2 of 2) JRL 5/2/78 following instruction used to be
;; a JRST. We must decrement byte count to take care of
;; current byte being written. This bug was formerly compensated
;; for above
SOJA A,.OUT2 ;CONTINUE
; SPECIAL DUMP-MODE OUTPUT STUFF
DMPO: PUSH P,D
HRRZ D,OBUF(CDB) ;PTR TO BUFFER AREA
SUBI D,1 ;ADDR-1 FOR IOWD
HRLI D,-=128 ;-WORD COUNT
MOVEI D+1,0
XCT IODOUT,SIMIO ;OUT D,
JFCL ;ERRORS HANDLED IN SIMIO
OKO: HRRZ B,D ;SAVE ADDR
HRLI D,1(D) ;BLT WORD
HRRI D,2(D)
SETZM -1(D)
BLT D,=128(B) ;CLEAR BUFFER
POP P,D ;RESTORE INPUT BYTE POINTER
AOS @ENDFL(CDB) ;SPECIAL TREATMENT
HRLI B,700 ;POINT 7,-1(1ST WORD),35
MOVEM B,OBP(CDB)
MOVEI A,5*=128 ;CHAR COUNT
MOVEM A,OCOWNT(CDB)
JRST .OUT2 ;AFTER OUTPUT SIMULATION, GO ON
ENDCOM(OUT)
COMPIL(INP,<INPUT>
,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,BKTCHK,X33,NOTOPN,GOGTAB
>
,<STRING INPUT ROUTINE>)
COMMENT ⊗Input ⊗
DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗
.IN.:
HERE (INPUT)
MOVE USER,GOGTAB ;GET TABLE POINTER
;;%##% FOR BENEFIT OF ERR ROUTINE
MOVE TEMP,(P)
MOVEM TEMP,UUO1(USER)
;;%##%
MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVE X,-1(P) ;TABLE #
MOVEI TEMP,-1 ;ERROR IF BLOCK NOT THERE, NEEDS TO BE INIT'ED
PUSHJ P,BKTCHK ;CHECHK OUT TABLE #
JRST [PUSH SP,[0] ;ERROR
PUSH SP,[0]
SUB P,X33
JRST @3(P)]
PUSH P,CDB ;SAVE POINTER TO CORGET BLOCK
PUSH P,CHNL ;SAVE RANGE 1 TO 18
MOVE CHNL,-4(P) ;CHANNEL #
LOADI7 A,<IN> ;ROUTINE NAME
PUSHJ P,GETCHN ;SET UP, VALIDATE
LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
CAIGE E,15 ;DUMP MODE?
SETZM @ENDFL(CDB) ;NO, HELP USER ASSUME NO EOF,ERR
SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
CMU <
SETZM .SKIP.
>;CMU
HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, TRY TO GET SOME
POP P,TEMP
MOVE FF,BRKMSK(TEMP) ;GET MASK FOR THIS TABLE
POP P,LPSA ;LPSA POINTS AT CORGET BLOCK
ADD TEMP,LPSA ;TEMP IS RELOCATED 1 TO 18
MOVEM TEMP,-1(P) ;SAVE THIS BLOODY THING ON THE STACK
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVN B,A ;NEGATE MAX CHAR COUNT
PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
MOVE Y,LPSA
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
NOCMU<
MOVEI C,0
>;NOCMU
CMU <
MOVS C,DMODE(CDB) ;FUNNY MODE BITS TO RH
>;CMU
;;%DQ% 2! JFR 8-17-76
TRNE FF,@BRKDUM(LPSA);TREAT NULLS LIKE ORDINARY CITIZENS?
IORI C,1 ;YES, FLAG BIT
TRNE FF,@BRKCVT(LPSA) ;DOING UC COERCION?
TLOA C,400000 ;YES
TLZ C,400000 ;NO
.IN: SOSG ICOWNT(CDB) ;BUFFER EMPTY?
JRST DOINP ;YES, GET MORE
IN1:
ILDB D,IBP(CDB) ;GET NEXT CHARACTER
TDNE Z,@IBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
JRST INLINN ;YES, GO SEE WHAT TO DO
IN2:
JUMPE D,[ TRNN C,1 ;REALLY IGNORE NULL??
JRST .IN ;YES
JRST .+1 ;NOPE
]
;;%AX% ugh! another instruction
SKIPE LINNUM(CDB) ;COUNTING VIA SETPL?
JRST [ CAIN D,12 ;LF?
AOS @LINNUM(CDB) ;YES -- BUMP COUNT
;; #TB# ! (CMU =C9) TYPO, USED TO BE CAIE C,14
CAIE D,14 ;FF?
JRST .+1 ;NOPE
SKIPN PAGNUM(CDB) ;BE SURE NO MESSUP
ERR <DRYROT -- SETPL LOSSAGE DETECTED IN INPUT>,1,NOCV.I
AOS @PAGNUM(CDB) ;BUMP PAGE COUNT
SETZM @LINNUM(CDB) ;THE LINE COUNT ← 0
JRST NOCV.I ;SINCE KNOW NOT LOWER CASE
]
;;%##% COERCING ??
JUMPGE C,NOCV.I ;NOT COERCIING ??
CAIL D,"a" ;ONLY COERCE LOWER CASE
CAILE D,"z" ;
JRST .+2 ;FAST SKIP
TRZ D,40 ;MAKE UC
NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
JRST INSPC ;YES, HANDLE
MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
AOJL B,.IN ;GET SOME MORE
JRST DONE1
INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
TDNN TEMP,FF ; (CHOOSE ONE)
JRST .IN ;IGNORE
; BREAK -- STORE BREAK CHAR, FINISH OFF
DONE: MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
MOVE TEMP,-1(P) ;RELOCATED 1 TO 18
SKIPN Y,DSPTBL(TEMP) ;WHAT TO DO WITH BREAK CHAR?
JRST DONE1 ;SKIP IT
JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
RETAIN: SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IBP(CDB)>
AOS ICOWNT(CDB)
JRST DONE1
APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
AOJA B,DONE1 ;ONE MORE TO COUNT
INEOF1: POP P,D+1 ;LEFT OVER FROM DUMP MODE ROUT
; DONE -- MARK STRING COUNT WORD
DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
;;#GI#
MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
JRST @3(P) ;RETURN
; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
; NOT A LINE NUMBER FOR NEXT TIME
; GET A NEW BUFFER
DOINP:
CMU <
AOS .SKIP.
>;CMU
CAIL E,15 ;DUMP MODE?
JRST DMPI ; YES
XCT IOIN,SIMIO ;IN CHAN,0
JRST IN1 ;ALL OK, CONTINUE
JRST DONE1 ;ERROR OR EOF, QUIT
; DUMP MODE SIMULATION OF SAME
DMPI: PUSH P,D+1
HRRZ D,IBUF(CDB) ;PTR TO BUFFER AREA
SUBI D,1
HRLI D,-=128
MOVEI D+1,0
XCT IODIN,SIMIO ;IN CHAN,D
JRST OKI
JRST INEOF1 ;REMOVE D,QUIT
OKI: POP P,D+1
AOS @ENDFL(CDB) ;SPECIAL TREATMENT
HRLI D,700
MOVEM D,IBP(CDB)
MOVEI A,5*=128
MOVEM A,ICOWNT(CDB)
JRST IN1 ;DONE SIMULATING, RETURN
INLINN:
;;%AX% MORE SETPL STUFF
SKIPE SOSNUM(CDB) ;DOES THE USER WANT IT???
JRST [ MOVE TEMP,@IBP(CDB) ;YES
MOVEM TEMP,@SOSNUM(CDB);
JRST .+1 ]
MOVE TEMP,-1(P) ;RELOCATED 1 TO 18
SKIPGE TEMP,LINTBL(TEMP) ;WHAT ABOUT LINE #?
JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
JSP TEMP,EATLIN ;TOSS IT OUT, AND
JRST .IN ; CONTINUE
EATLIN:
AOS IBP(CDB) ;FORGET IT ENTIRELY
MOVNI A,5 ;INDICATE SKIPPING SIX
ADDB A,ICOWNT(CDB) ;IN COUNT
;OVERFLOW BUFFER?
JUMPG A,(TEMP) ;NO, CONTINUE
CAIL E,15
ERR <CAN'T HANDLE THIS FILE IN DUMP MODE>
XCT IOIN,SIMIO ;YES, GET TAB FROM NEXT BUFFER
JRST OKLN ;GOT IT, CONTINUE
JRST DONE1
OKLN: SOSG ICOWNT(CDB) ;IF ONLY ONE CHAR,
JRST [MOVEI TEMP,20000 ;THEN EOF COMES NEXT
IORM TEMP,@ENDFL(CDB)
JRST DONE1] ;ALL DONE
IBP IBP(CDB) ;GET OVER TAB FINALLY
;;#PM 12-1-73 RLS DONT LOSE A CHARACTER IN THE (NEW) BUFFER
AOS ICOWNT(CDB) ;INCREMENT COUNT
;;#PM
JRST (TEMP) ;AND CONTINUE
GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
JRST GVLLN ;NO, WANTS IT NEXT TIME.
SKIPL TEMP,@IBP(CDB) ;NEGATED LINE NO
MOVNS TEMP
MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
JRST DONE1 ;FINISH UP
GVLLN:
SETOM @BRCHAR(CDB) ;TELL THE USER
AOS ICOWNT(CDB) ;REVERSE THE SOSLE
MOVEI Y,1 ;TURN OFF LINE NUMBER
ANDCAM Y,@IBP(CDB) ; BIT
MOVSI Y,070000 ;BACK UP BYTE POINTER
ADDM Y,IBP(CDB)
JRST DONE1 ;FINISH OFF IN BAZE OF GORY
ENDCOM(INP)
COMPIL(NUM,<LREALIN,LREALSCAN,REALIN,REALSCAN,INTIN,INTSCAN>
,<SIMIO,SAVE,RESTR,X11,X22,X33,X44,GETCHN,NOTOPN>
,<STRING TO NUMBER CONVERSION>)
IFN ALWAYS,<BEGIN NUMIN>
HERE (REALIN)
PUSHJ P,SAVE
PUSHJ P,NUMIN ;SET UP TO GET CHARS FROM CHANNEL
PUSHJ P,RLNIN ;GOBBLE A REAL NUMBER
SNGL A,A
INRETA: MOVEM A,RACS+A(USER)
INRET:
MOVEM Z,@BRCHAR(CDB) ;FIX UP BREAK CHARACTER
SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IBP(CDB)>
AOS ICOWNT(CDB)
MOVE LPSA,X22 ;GET RID OF CHANNEL AND RET. WD
JRST RESTR
HERE (REALSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN ;SET UP TO GET CHARS FROM A STRING
PUSHJ P,RLNIN
SNGL A,A
STRRTA: MOVEM A,RACS+A(USER)
STRRET:
HRRZ X,-2(P)
SOJ CDB, ;BACK UP BYTE POINTER
FOR II←1,4<
IBP CDB>
MOVEM CDB,(X)
AOJ CHNL,
HRRM CHNL,-1(X)
MOVEM Z,@-1(P) ;STORE BREAK CHARACTER
MOVE LPSA,X33 ;GET RID OF BRK VAR, STR ADDR
JRST RESTR
FNDDIG: ;FIND DIGIT OR DECIMAL POINT, KEEP TRACK OF SIGN
EXCH A,(P) ;FIRST PUT "GET NEXT CHAR" INSTR ON STACK
PUSH P,A ;AHEAD OF RETURN WORD
FNDDI1: XCT -1(P) ;GET NEXT CHAR
CAIL D,"0"
CAILE D,"9"
CAIN D,"."
POPJ P,
JUMPL D,.-1 ;EOF OR END OF STRING
CAIN D,"-"
TLOA FF,NUMNEG
TLZ FF,NUMNEG ;SIGN MUST IMMEDIATELY PRECEDE NUMBER
JRST FNDDI1
RLNIN:
SETZ FF, ;ZERO FLAGS
PUSHJ P,FNDDIG
JUMPL D,.+2
TLO FF,NUMSAW ;THERE WAS PART OF A NUMBER
PUSHJ P,GETNUM ;TRY FOR AN INTEGER
CAIE D,"."
TRZA C,-1 ;NO DIGITS AFTER DEC PT.
PUSHJ P,GETN1D ;FINISH UP FRACTION
EXCH C,(P) ;DIGIT COUNTS ↔ NXTCHR INSTR
PUSH P,X ;PARTIAL RESULT
PUSH P,Y
PUSH P,FF ;FLAGS
PUSH P,C ;NXTCHR INSTR
SETZ FF, ;EXPONENT FLAGS
CAIE D,"@"
CAIN D,"E"
JRST [XCT (P) ;EAT A CHAR
CAIE D,"@"
CAIN D,"E"
RLNIN2: XCT (P) ;ALLOW FOR TWO OF THESE
CAIN D,"-"
TLOA FF,NUMNEG
CAIN D,"+"
XCT (P) ;PAST SIGN
PUSHJ P,GETNUM ;RECURSE FOR EXPONENT
PUSHJ P,TZMUL ;GET EXPONENT AS AN INTEGER
JUMPN C,RLNIN1
ERR <NUMIN: Improper exponent>,1 ;NO DIGITS APPEARED
JRST RLNIN1
]
CAIN D,"D"
JRST RLNIN2
SETZB X,Y ;EXPONENT IS ZERO
SETZ C, ;AND THERE WERE NO DIGITS IN IT
RLNIN1:
MOVE Z,D ;SAVE BRCHAR (COULD BE -1 FOR EOF)
SUB P,X11 ;GET RID OF NXTCHR INSTR
TLNN FF,NUMNEG
SKIPA D,Y ;LOW WD OF EXPONENT
MOVN D,Y ;EXPONENT WAS NEG
POP P,FF ;FLAGS OF FRACTION
;-2(P): FRACTION DIGIT COUNTS
;-1(P), -0(P): FRACTION
TLNN C,-1 ;IF ANY TRAILING ZEROES LEFT, A WHOPPING BIG EXP.
SKIPE X ;HIGH PART HAD BETTER BE ZERO
JRST [SUB P,X33 ;WIPE OUT FRACTION AND DIGIT COUNTS
JRST DFSERR] ;AND COMPLAIN
POP P,Y ;FRACTION PART
POP P,X
POP P,C ;DIGIT COUNTS OF FRACTON
JRST DFSC
HEREFK(LREALIN,LREA.IN)
PUSHJ P,SAVE
PUSHJ P,NUMIN
PUSHJ P,RLNIN
DMOVEM A,RACS+A(USER)
JRST INRET
HEREFK(LREALSCAN,LREA.SCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
PUSHJ P,RLNIN
DMOVEM A,RACS+A(USER)
JRST STRRET
HERE (INTIN)
PUSHJ P,SAVE
PUSHJ P,NUMIN
PUSHJ P,RLNIN
SNGL A,A
PUSHJ P,RFIX
JRST INRETA
RFIX: ;SIGN(A)*FLOOR(ABS(A)+0.5)
KI10< JUMPL A,.+3
FIXR A,A
POPJ P,
MOVN A,A
FIXR A,A
MOVN A,A
POPJ P,
>;KI10
NOKI10< JUMPL A,.+4
FADRI A,(0.5) ;SORRY, 166 !
FIX A,A
POPJ P,
MOVN A,A
FADRI A,(0.5)
FIX A,A
MOVN A,A
POPJ P,
>;NOKI10
HERE (INTSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
PUSHJ P,RLNIN
SNGL A,A
PUSHJ P,RFIX
JRST STRRTA
COMMENT \
.INSERT SAILPD.FAI[S,AIL]
SAILPD ($REALIN,REAL,1,0,<INTEGR>)
SAILPD ($INTIN,INTEGR,1,0,<INTEGR>)
SAILPD ($REALSCAN,REAL,2,0,<STRING+REFERENCE,INTEGR+REFERENCE>)
SAILPD ($INTSCAN,INTEGR,2,0,<STRING+REFERENCE,INTEGR+REFERENCE>)
SAILPD (LREALIN,DBLPRC+REAL,1,0,<INTEGR>)
SAILPD (LREALSCAN,DBLPRC+REAL,2,0,<STRING+REFERENCE,INTEGR+REFERENCE>)
\
NUMIN: ;SET UP TO READ FROM A CHANNEL
MOVE CHNL,-2(P)
LOADI7 A,<IN>
PUSHJ P,GETCHN; SET UP FOR INPUT
SETZM @ENDFL(CDB); CLEAR EOF AND BREAK FLAGS
SETZM @BRCHAR(CDB)
MOVE A,[JSP A,NCH]
MOVEI Z,1; FOR LINE NUMBER TEST
POPJ P,
NCH: SOSG ICOWNT(CDB); DECREMENT CHARACTER COUNT
JRST NCH2
NCH1: ILDB D,IBP(CDB); LOAD BYTE
TDNE Z,@IBP(CDB); CHECK FOR LINE NUMBER
JRST NCH5
CAIN D,15 ;IGNORE CR
JRST NCH
JUMPE D,NCH ;AND NUL
SKIPN LINNUM(CDB) ;WANT SETPL STUFF???
JRST (A) ;NO, RETURN
CAIN D,12 ;YES, IS THIS A LF?
AOS @LINNUM(CDB) ;YES, BUMP LINE COUNT
CAIE D,14 ;A FF?
JRST (A) ;NOPE
SKIPN PAGNUM(CDB) ;BUG TRAP
JRST [ ERR <DRYROT -- SETPL LOSSAGE DETECTED BY NUMIN>,1
JRST (A) ]
AOS @PAGNUM(CDB) ;BUMP PAGE COUNT
SETZM @LINNUM(CDB) ;ZERO LINE COUNT
JRST (A) ;RETURN
NCH2: XCT IOIN,SIMIO; INPUT
JRST NCH1 ;ALL OK
NCH7: SETO D, ;EOF OR DATA ERROR.
JRST (A)
NCH5:
SKIPE SOSNUM(CDB) ;DOES THE LOSER WANT IT??
JRST [ MOVE D,@IBP(CDB) ;YES, GET IT
MOVEM D,@SOSNUM(CDB) ;WHERE HE SAID TO PUT IT
JRST .+1]
AOS IBP(CDB); WE HAVE A LINE NUMBER
MOVNI D,5; MOVE OVER IT
ADDB D,ICOWNT(CDB)
SKIPLE D; NOTHING LEFT
JRST NCH; DO ANOTHER INPUT
XCT IOIN,SIMIO
NCH6: SOSG ICOWNT(CDB); REMOVE TAB
JRST NCH7 ;NONE THERE OR ERROR
IBP IBP(CDB)
JRST NCH
STRIN: ;SET UP TO READ FROM A STRING
MOVE A,[JSP A,NCHA]
HRRZ CHNL,-3(P) ;ADDR OF WD2
MOVE CDB,(CHNL) ;BP
HRRZ CHNL,-1(CHNL) ;LENGTH
POPJ P,
NCHA: SOJL CHNL,NCH7
ILDB D,CDB
CAIN D,15
JRST NCHA ;IGNORE CR
JUMPE D,NCHA ;AND NUL
JRST (A)
;LNUMIN NUMBER INPUT
COMMENT ⊗
These routines form a character-string
to number conversion package. GETNUM eats characters one at a time
until a non-digit is eaten; GETNUM then returns intermediate information
which can be used by the other routines.
GETNU1 is the routine to call
after GETNUM when a decimal point is seen and you eventually want a floating
point number.
GETNUM: -1(P) instruction to XCT, gets next character in D
(P) return word
D first digit
result: as in GETNU1
GETNU1: X,Y double length partial integer result
-1(P) instruction to XCT, gets next character in D
(P) return word
C # trailing zeroes ,, power of 10 scale factor
D first digit
result: X,Y double length partial integer result
(P) instructin to XCT, gets next character in D
FF flags (sign, overflow)
C # trailing zeroes ,, scale factor + # digits since then
D break character
MAKINT: X,Y double length partial integer result
(P) return word
FF sign flag
C # trailing zeroes ,, junk
result: A integer value
DFSC:
X,Y double length partial integer result
(P) return word
FF flags
C # trailing zeroes ,, # digits since decimal point
D exponent
result: A,B floating point value
AC USAGE:
FF flags
A,B double temp return word for JSP NCH
C #tz ,, # digits
D char
X,Y double integer partial result
Z 1 (for testing line numbers)
CHNL channel number, or # chars left in string
CDB channel data block addr, or bp to string
RF res.
LPSA scale factor for DMUL gen.temp.
TEMP gen. temp.
USER res.
SP res.
P res.
⊗
;GETNUM GETNU1
NUMNEG←←400000
EXPNEG←←200000
NUMSAW←←100000
GETNUC: XCT -1(P) ;GET A CHAR FIRST
GETNUM:
SETZB X,Y ;INITIAL RESULT
SETZ C, ;DIGIT COUNTS
JRST 2,@.+1 ;CLEAR FLAGS
GETNU1
GETN1D: TRZA C,-1 ;NUMBER OF DIGITS SINCE DEC. PT IS ZERO
GETN1E: AOBJN C,.+1 ;A TRAILING ZERO
GETN1C: XCT -1(P) ;GET NEXT CHAR
GETNU1: CAIL D,"0"
CAILE D,"9"
POPJ P, ;NOT DIGIT
SUBI D,"0" ;CONVERT TO DIGIT NOW
JUMPE D,GETN1E ;A TRAILING ZERO
ADDI C,1 ;ANOTHER DIGIT
TLNE C,-1 ;WERE THERE TRAILING ZEROES BEFORE IT?
PUSHJ P,TZMUL ;YES
PUSHJ P,M10ADD ;MULT BY =10 AND ADD D
JRST GETN1C
TZMUL: HLRZ TEMP,C ;# TRAILING ZEROES
JUMPE TEMP,CPOPJ ;QUIT IF NONE
MOVEI C,(C) ;WILL BE NONE IF WE FINISH WITHOUT OVERFLOW
;;%YZ% pmf Feb 11 77
; CAIN TEMP,(C)
; JRST CPOPJ ;TRAILERS WERE ALSO LEADERS!
MOVEI LPSA,(D) ;SAVE DIGIT
SETZ D,
PUSHJ P,M10ADD ;ADJUST VALUE TO ACCOUNT FOR TRAILING ZEROES
SOJG TEMP,.-2
MOVEI D,(LPSA) ;RESTORE D
POPJ P,
M10ADD:
MOVE A,Y ;LOW HALF
MULI A,=10
TLO A+1,400000 ;PREVENT OVERFLOW
ADDI A+1,(D) ;ADD NEW DIGIT
TLZN A+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI A,1 ;YES. (THIS CAN'T OVERFLOW; A WAS AT MOST 9)
MOVE D,X ;HIGH HALF
IMULI D,=10
JOV [ADD C,X11 ;PRETEND WE HAD A TRAILING ZERO
SOJA C,CPOPJ]
TLO D,400000 ;PREVENT OVERFLOW
ADDI D,(A) ;CARRY IN FROM LOW HALF
TLZN D,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
JRST @.-4 ;YES
MOVEM A+1,Y ;STORE LOW HALF
MOVEM D,X ;AND HIGH HALF
CPOPJ: POPJ P,
;DFSC
; FF NUMNEG FLAG
; C # TRAILING ZEROES,, # DIGITS SINCE DECIMAL PT.
; D EXPONENT
; X,Y FRACTION
DFSC:
MOVE A,X ;BEGIN CONVERTING TO PURE FRACTION
JFFO A,DFSC1
MOVE A,X+1 ;HIGH WD WAS ZERO
JFFO A,.+1
ADDI A+1,=35
DFSC1: MOVEI LPSA,-1(A+1) ;# OF PLACES TO SHIFT (REMEMBER SIGN BIT)
ASHC X,(LPSA) ;MAKE INTO PURE FRACTION
SUBI LPSA,=70
MOVN LPSA,LPSA ;EXPONENT OF 2 OF FRACTION
;***** SOMETHING FISHY HERE. CONSIDER 12345.98@3
SUBI D,(C) ;DIGITS SINCE DECIMAL POINT DECREASE THE EXPONENT
HLRZ C,C
ADDI D,(C) ;BUT TRAILING ZEROES DONT COUNT
JUMPE D,DFSC2 ;EXPONENT OF 10 IS ZERO
JUMPG D,DFSC3
TLO FF,EXPNEG ;EXPONENT WAS NEG
MOVN D,D
SKIPA TEMP,[EXP.M1,,FR.M1] ;USE THIS TABLE SINCE EXP WAS NEG
DFSC3: MOVE TEMP,[EXP.P1,,FR.P1] ;EXP WAS POS
TRNE D,777700 ;CHECK EXPONENT RANGE
JRST DFSERR
TRNE D,40 ;E+-32 INVOLVED?
TLNE FF,EXPNEG ;YES. TOO BAD IF E-48
JRST MULOOP ;OK
TRNE D,20 ;E-48 ?
JRST DFSERR
MULOOP: TRZE D,1 ;SHOULD WE MULTIPLY?
PUSHJ P,DMUL.. ;YES
JUMPE D,DFSC2
ASH D,-1 ;NEXT BIT INTO POSITION
AOBJN TEMP,.+1 ;ADD 1 TO LH
AOJA TEMP,MULOOP ;AND 2 TO RH
DFSC2:
KI10< DMOVE A,X >;KI10
NOKI10< MOVE A,X
MOVE A+1,X+1 >;NOKI10
ASHC A,-8 ;MAKE ROOM FOR EXPONENT
FSC A,200(LPSA) ;INSERT IT
JFOV DFSERR
DFSC4:
JUMPGE Z,.+3 ;IF RAN OUT OF CHARS
TLNE FF,NUMSAW ; AND SAW NUMBER
MOVEI Z,0 ; THEN FLAG IT THIS WAY
KI10< TLNE FF,NUMNEG
DMOVN A,A
POPJ P,
>;KI10
NOKI10< TLNN FF,NUMNEG
POPJ P,
SETCA A, ;ONES COMPLEMENT OF HIGH WORD
MOVN A+1,A+1 ;TWOS COMPLEMENT OF LOW WORD
TLZ A+1,400000 ;FORCE SIGN BIT OFF
JUMPN A+1,CPOPJ ;IF LOW SIGNIFICANCE, DONE
AOJA A,CPOPJ ;OTHERWISE TWOS COMPLEMENT OF HIGH WORD
>;NOKI10
DFSERR: ERR <NUMIN: Exponent range exceeded>,1
SETOB A,A+1
TLNN FF,EXPNEG
TLZA A,400000 ;EXPONENT WAS POS, GIVE AN INFINITY
SETZB A,A+1 ;EXPONENT WAS NEG, GIVE ZERO
JRST DFSC4 ;OF RIGHT SIGN
;DMUL..
;MULTIPLY TWO DOUBLE-LENGTH PURE FRACTIONS. ONE IS (TEMP), OTHER IS X,Y PAIR
;RETURN DOUBLE-LENGTH RESULT IN X,Y
;SCALE FACTOR KEPT IN LPSA
DMUL..:
NOKL10< PUSH P,X ;SAVE HIGH
SETZM X ;1ST WORD, FINAL PRODUCT
MOVE A,(TEMP) ;HIGH
MULM A,Y ;* LOW
;IGNORING 3RD WORDS: 8 EXPONENT BITS TO BURN
MOVE A,1(TEMP) ;LOW
MUL A,(P) ;* HIGH
TLO A,400000 ;PREVENT OVERFLOWS
ADD A,Y ;ADD 2ND WORDS
TLZN A,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
AOS X ;YES, DO CARRY (SETS X TO 1)
MOVEM A,Y ;STORE LOW RESULT
POP P,A ;HIGH
MUL A,(TEMP) ;* HIGH
TLO A+1,400000 ;PREVENT OVERFLOW
ADD A+1,Y ;COLLECT 2ND WORD
TLZN A+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI A,1 ;YES
ADD A,X ;COLLECT 1ST WORD (THIS CAN'T OVERFLOW)
>;NOKL10
KL10<
DMOVE A,X
DMOVEM A+2,X
DMUL A,(TEMP)
DMOVE A+2,X
>;KL10
TLNE A,(1B1) ;NORMALIZED FRACTION?
JRST .+3 ;YES
ASHC A,1 ;NO, SHIFT OVER
SUBI LPSA,1 ;AND ADJUST EXPONENT
MOVS TEMP,TEMP ;COLLECT EXPONENT CHANGES
ADD LPSA,(TEMP)
MOVS TEMP,TEMP
MOVEM A,X ;STORE RESULT SO FAR
MOVEM A+1,Y
POPJ P,
FR.P1: 240000,,0 ;10↑1 PURE FRACTION PART
0
310000,,0 ;10↑2
0
234200,,0 ;10↑4
0
276570,,200000 ;10↑8
0
216067,,446770 ;10↑16
040000,,0
235613,,266501 ;10↑32
133413,,263574
EXP.P1: 4 ;POWER OF 2 EXPONENT PART
7
16
33
66
153
FR.M1: 314631,,463146 ;10↑-1
146314,,631463
243656,,050753 ;10↑-2
205075,,314217
321556,,135307 ;10↑-4
020626,,245364
253630,,734214 ;10↑-8
043034,,737425
346453,,122766 ;10↑-16
042336,,053314
317542,,172552 ;10↑-32
051631,,227215
EXP.M1: -3
-6
-15
-32
-65
-152
ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗
↑↑.CH.: 4
7
16
33
66
153
777777777775
777777777772
777777777763
777777777746
777777777713
777777777626
↑↑.MT.: 240000000000
310000000000
234200000000
276570200000
216067446770
235613266501
314631463147
243656050754
321556135310
253630734215
346453122767
317542172553
↑↑.TEN.: 1
=10
=100
=1000
=10000
=100000
=1000000
=10000000
=100000000
=1000000000
=10000000000
ENDCOM(TBB)
IFN ALWAYS,<
BEND
>;IFN ALWAYS
COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
COMMENT ⊗Arryout, Wordout ⊗
DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
CAL SAIL
⊗
HERE (ARRYOUT)
PUSHJ P,SAVE
MOVE LPSA,[XWD 4,4]
ARO: MOVE CHNL,-3(P)
LOADI7 A,<ARRYOUT>
PUSHJ P,GETCHN
;;%##% CONSIDER THIS
CMU <
SETZM @ENDFL(CDB) ;CLEAR ERROR FLAG
>;CMU
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 1 OF 13 -- FOR CMU SPECIAL MODES.
MOVEI Z,1 ;ASSUME NOT IMP MODE
CAIN TEMP,3 ;IS THE MODE 3?
TRZA Z,-1 ; YES - CMU 32-BIT IMP MODE.
; WE WILL USE Z BOTH AS SIGNAL AND AS
; A GUARANTEED 0 THAT CAN BE USED FOR A DPB
CAIN TEMP,4 ; (THIS ONE IS CMU-IMAGE MODE)
JRST OUTRAY ; THEN OKAY, NOT DUMP MODE EITHER.
;;=B4=
>;CMU
CAIGE TEMP,10 ;MAKE SURE AT LEAST BINARY MODE
ERR <ARRYOUT: mode must be '14,'10, or '17, not >,6
MOVE 0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
CAIL TEMP,15
JRST ARYDMP ;COMMON DUMP MODE ROUTINE
OUTRAY: MOVE A,-2(P) ;STARTING LOC
SKIPGE B,-1(P) ;EXTENT
ERR <ARRYOUT: negative word count, value is>,6
;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE
WOUT2: SKIPG E,OCOWNT(CDB) ;# WORDS LEFT IN BUFFER
JRST WOUT5 ;BETTER GET ANOTHER BUFFER
JUMPE B,RESTR ;NOTHING LEFT TO DO
CMU <
;;=B4= 2 OF 13
CAIN Z,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
IBP OBP(CDB) ;MAKE SURE PTRS TO FIRST WORD
CMU <
;;=B4= 3 OF 13
CAIN Z,0 ;IMP MODE?
DPB Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
MOVE C,OBP(CDB) ;"TO" ADDR
HRRZI D,(C) ;FOR BLT TERMINATION CALCULATION
HRLI C,(A) ;"FROM" ADDR
CAIGE B,(E) ;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
;IF WE JUST FILL THE BUFFER)
JRST WOUT3 ;YES
ADDI D,-1(E) ;FINAL ADDR
BLT C,(D) ;DO IT!
ADDI A,(E) ;UPDATE PTR
SUBI B,(E) ;AND COUNT
SETZM OCOWNT(CDB)
HRRM D,OBP(CDB)
WOUT5: XCT IOOUT,SIMIO ;DO THE OUTPUT
JFCL ;ERRORS HANDLED ALREADY
JRST WOUT2 ;TRY NEXT CHUNK
WOUT3: JUMPLE B,RESTR ;NOTHING TO MOVE
SUBI B,1
ADD D,B ;END OF BLOCK
BLT C,(D) ;MOVE IT
SUBI E,1(B) ;FIX LENGTH
CMU <
;;=B4= 4 OF 13
CAIN Z,0 ;IMP MODE?
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
;;=B4=
>;CMU
MOVEM E,OCOWNT(CDB) ;
ADDM B,OBP(CDB) ;FIX BYTE POINTER
;;#FQ# (1-4)
JRST RESTR ;LEAVE LIKE A TREE AND MAKE
DSCR WORDOUT(CHAN,VALUE);
CAL SAIL
⊗
HERE (WORDOUT) ;WRITE ONE WORD
PUSHJ P,SAVE
MOVE LPSA,X33
MOVE CHNL,-2(P)
LOADI7 A,<WORDOUT>
PUSHJ P,GETCHN
;;%##% CONSIDER THIS
CMU <
SETZM @ENDFL(CDB) ;CLEAR ERROR FLAG
>;CMU
LDB A,[POINT 4,DMODE(CDB),35];DATA MODE
CAIL A,15 ;A DUMP MODE?
JRST DMPWO ;WO IS ME, YES
;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
WDO: SOSL OCOWNT(CDB) ;BUFFER FULL?
JRST WOKO ;NO
XCT IOOUT,SIMIO ;YES, WRITE IT
JFCL ; ERRORS HANDLED ELSEWHERE
JRST WDO ;GO BACK AND DO IT RIGHT
WOKO: MOVE TEMP,-1(P) ;THING TO BE WRITTEN
IDPB TEMP,OBP(CDB) ;WRITE IT
JRST RESTR
DMPWO: MOVE LPSA,[XWD 7,7] ;ACCOUNT FOR EVERYTHING
MOVEI TEMP,-1(P) ;PNT TO WORD TO BE WRITTEN
PUSH P,-2(P) ;CHANNEL
PUSH P,TEMP ;ADDR OF WORD
PUSH P,[1] ;COUNT
PUSHJ P,ARO ;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
;;#FQ# (2-4)
COMMENT ⊗Arryin, Wordin ⊗
DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
CAL SAIL
⊗
HERE (ARRYIN)
PUSHJ P,SAVE
MOVE LPSA,X44
ARI: MOVE CHNL,-3(P)
LOADI7 A,<ARRYIN>
PUSHJ P,GETCHN
SETZM @ENDFL(CDB) ;ASSUME NO END OF FILE
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
CMU <
;;=B4= 5 OF 13
MOVEI Z,1 ;ASSUME NOT IMP MODE
CAIN TEMP,3 ;IS THE MODE 3?
TRZA Z,-1 ; YES - CMU 32-BIT IMP MODE.
CAIN TEMP,4 ;IF ONE OF THE SPECIAL CMU MODES,
JRST INARY ; THEN OKAY, NOT DUMP MODE EITHER
;;=B4=
>;CMU
CAIGE TEMP,10
ERR <ARRYIN: mode must be '10 or '14 or '17, not >,6
MOVE 0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
CAIL TEMP,15
JRST ARYDMP ;USE COMMON ROUTINE
;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
INARY: MOVE A,-2(P) ;STARTING LOC
SKIPGE B,-1(P) ;EXTENT
ERR <ARRYIN: negative word count, value is >,6
WIN3: JUMPE B,RESTR ;NOTHING LEFT TO DO
SKIPG E,ICOWNT(CDB) ;#LEFT IN BUFFER
JRST WIN5
CMU <
;;=B4= 6 OF 13
CAIN Z,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
IBP IBP(CDB) ;MAKE SURE PTS TO NEXT
HRL C,IBP(CDB) ;ADDR OF FIRST WORD TO READ
MOVEI D,(A) ;FOR BLT TERMINATION
HRR C,A ;"TO" ADDRESS
CAIG B,(E) ;ENOUGH HERE?
JRST WIN4 ;YES
ADDI D,-1(E) ;NO, FINISH THIS BUFFER
BLT C,(D)
ADD A,E ;FIX INPUT POINTER
SUB B,E ;FIX INPUT COUNT
WIN5: XCT IOIN,SIMIO ;DO INPUT
JRST WIN3 ;OK, GO AHEAD
JRST WIEOF1 ;EOF OR ERROR, LEAVE
WIN4: ADDI D,-1(B) ;FINISH UP
BLT C,(D)
SUB E,B ;FIX UP COUNT
CMU <
;;=B4= 7 OF 13
CAIE Z,0 ;IMP MODE?
JRST .+3
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
DPB Z,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
SUBI B,1 ;PREPARE TO CORRECT BP
MOVEM E,ICOWNT(CDB) ;UPDATE WORDS LEFT
ADDM B,IBP(CDB) ; POINTER
;;#FQ# (3-4)
JRST RESTR ;LEAVE
WIEOF1: MOVE TEMP,-1(P) ;#WORDS WANTED -1
SUBM TEMP,B ;#INPUT IN RH
WIN2: HRRM B,@ENDFL(CDB) ;#INPUT IN RH, ERR OR EOF BITS IN LH
JRST RESTR
DSCR VALUE←WORDIN(CHAN);
CAL SAIL
⊗
HERE (WORDIN) ;READ ONE WORD -- USE ARRYIN
PUSHJ P,SAVE
MOVE LPSA,X22
LOADI7 A,<WORDIN>
MOVE CHNL,-1(P) ;CHANNEL NUMBER
PUSHJ P,GETCHN
;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
LDB TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
CAIL TEMP,15 ;DUMP MODE?
JRST DUMPWI ; YES
SETZM @ENDFL(CDB)
WI: SOSL ICOWNT(CDB)
JRST WOKI ;ALL OK
XCT IOIN,SIMIO
JRST WI ;OK, GO BACK TO KEEP COUNT RIGHT
TDZA A,A ;RETURN 0, WITH ERROR
WOKI: ILDB A,IBP(CDB) ;OK, RETURN NEXT WORD
MOVEM A,RACS+1(USER) ;RESULT
JRST RESTR
DUMPWI: MOVE LPSA,[XWD 6,6]
MOVEI TEMP,RACS+1(USER);RESULT GOES HERE
PUSH P,-1(P) ;CHANNEL
PUSH P,TEMP ;ADDRESS
PUSH P,[1] ;1 WORD TRANSFER
PUSHJ P,ARI ;WON'T RETURN, JUST SYNCH STACK
;;#FQ# (4-4)
ARYDMP:
MOVN TEMP,-1(P) ;-WORD COUNT
JUMPGE TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
SOS D,-2(P) ;STARTING ADDR - 1
HRL D,TEMP ;IOWD -COUNT,STARTING ADDR -1
MOVEI D+1,0 ;TERMINATE THE READ
MOVE A,[JRST RESTR] ;IF IT SUCCEEDS
MOVE B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
JRST 0 ;GO DO DUMP I/O
HERE(WRDSP1)
HERE(WRDSP2)
HERE(WRDSP3)
ERR <DRYROT WRD SPARES>
ENDCOM(WRD)
COMPIL(THR,<INOUT>,<SIMIO,SAVE,RESTR,GETCHN>
,<THROUGH I/O ROUTINE>)
COMMENT ⊗ INOUT ⊗
DSCR INOUT(INCHAN,OUTCHAN,EXTENT);
CAL SAIL
⊗
HERE (INOUT)
PUSHJ P,SAVE ;SAVE AC'S,GET GOGTAB
MOVE LPSA,[XWD 6,6]
MOVE CHNL,-2(P) ;OUTPUT CH NUMBER
LOADI7 A,<INOUT (OUTPUT SIDE)>
PUSHJ P,GETCHN
SETZM @ENDFL(CDB) ;CLEAR ERROR INDICATOR
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 8 OF 13
MOVEI Z,1
CAIN TEMP,3 ;IS THE MODE 3
TRZA Z,-1 ; YES!!!
CAIN TEMP,4 ;OR CMU IMAGE MODE?
JRST .+4 ;UGLY, BE CAREFUL OF CODE CHANGES!
;;=B4=
>;CMU
CAIL TEMP,10 ;MUST BE BINARY MODE
CAILE TEMP,14 ;AND NOT DUMP MODE
ERR <INOUT (OUTPUT SIDE): ILLEGAL DATA MODE:>,6
PUSH P,CDB ;SAVE -
PUSH P,CHNL ;WELL DO IT AGAIN
MOVE CHNL,-5(P) ;SEE...
LOADI7 A,<INOUT (INPUT SIDE)>
PUSHJ P,GETCHN ;DO YOUR THING
SETZM @ENDFL(CDB) ;CLEAR ERROR INDICATOR
LDB TEMP,[POINT 4,DMODE(CDB),35]
CMU <
;;=B4= 9 OF 13
MOVEI Y,1
CAIN TEMP,3 ;IS THE MODE 3
TRZA Y,-1 ;YES!!!
CAIN TEMP,4 ;OR CMU IMAGE MODE
JRST .+4 ;CAREFUL OF RELATIVE JUMPS!
;;=B4=
>;CMU
CAIL TEMP,10
CAILE TEMP,14
ERR <INOUT (INPUT SIDE): ILLEGAL DATA MODE:>,6
SKIPGE B,-3(P) ;# OF WORDS
HRLOI B,377777 ;ARBITRARILY LARGE NUMBER OF WDS
TH1: JUMPE B,RESTR ;NO MORE TO DO
SKIPG E,ICOWNT(CDB) ;#OF WORDS IN BUFFER
JRST TH5 ;BETTER GET SOME MORE
CMU <
;;=B4= 10 OF 13
CAIN Y,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
IBP IBP(CDB) ;MAKE SURE POINT TRIGHT
HRL C,IBP(CDB) ;INPUT POINTER
EXCH CHNL,(P) ;NOW FREEN OUTPUT STUFF
EXCH CDB,-1(P)
SKIPG OCOWNT(CDB) ;SOME LEFT
XCT IOOUT,SIMIO
SKIPA
JRST THERR
IBP OBP(CDB)
HRR C,OBP(CDB) ;OUTPUT POINTER
CAML E,B ;FIND # OF WORDS
MOVE E,B ;TO BLIT
NOCMU <
;;=B4= 11 OF 13
CAML E,OCOWNT(CDB) ;=MIN(B,ICOWNT,OCOWNT)
MOVE E,OCOWNT(CDB)
>;NOCMU
CMU <
CAMGE E,OCOWNT(CDB) ;=MIN(B,ICOWNT,OCOWNT)
JRST .+4
MOVE E,OCOWNT(CDB)
CAIN Z,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BYTE COUNT BY 4
;;=B4=
>;CMU
MOVEI D,(C) ;MAKE BLT TERMINATOR
ADDI D,-1(E) ;FINAL ADDRESS
BLT C,(D) ;CHOMP CHOMP
SUB B,E ;WE'VE DONE THESE
MOVEI A,-1(E) ;TO UPDATE BYTE POINTER
ADDM A,OBP(CDB) ;TOLD YOU SO
CMU <
;;=B4= 12 OF 13
CAIE Z,0 ;IMP MODE?
JRST .+3
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
DPB Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
SUBM E,OCOWNT(CDB) ;UPDATE WORD COUNT
MOVNS OCOWNT(CDB) ;CLEVER,EH?
TH6: EXCH CHNL,(P) ;BACK TO INPUT SETUP
EXCH CDB,-1(P)
ADDM A,IBP(CDB) ;UPDATE INPUT PTR
CMU <
;;=B4= 13 OF 13
CAIE Y,0 ;IMP MODE?
JRST .+3
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
DPB Y,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
SUBM E,ICOWNT(CDB) ;UPDATE WORD COUNT
MOVNS ICOWNT(CDB) ;SUBTRACTION WAS BACKWARDS
JRST TH1 ;MORE OF SAME
TH5: XCT IOIN,SIMIO ;DO SOME INPUT
JRST TH1 ;NOW GO PLAY
THERR: SKIPGE TEMP,-3(P) ;# THE GUY WANTED
HRLOI TEMP,377777 ;IT WAS A FUDGE
SUB TEMP,B ;SUBTRACT #LEFT TO GET
HRRM TEMP,@ENDFL(CDB);#HE GOT
JRST RESTR
ENDCOM(THR)
COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
COMMENT ⊗Linout ⊗
DSCR LINOUT(CHANNEL,VALUE);
CAL SAIL
⊗
HERE (LINOUT)
PUSHJ P,SAVE
MOVE CHNL,-2(P) ;CHANNEL
LOADI7 A,<LINOUT>
PUSHJ P,GETCHN ;CHANNEL DATA
MOVE TEMP,OBP(CDB) ;ADJUST TO FULL WORD
HRRZ A,OCOWNT(CDB) ;DON'T FORGET COUNT
LINOLP: TLNN TEMP,760000 ;LINED UP?
JRST OKLIGN ; YES
IBP TEMP ;0 WILL BE THERE
SOJA A,LINOLP
OKLIGN: MOVEM TEMP,OBP(CDB)
MOVEM A,OCOWNT(CDB) ;REPLACE UPDATED THINGS
CAIGE A,=10 ;ENOUGH ROOM FOR 2 WORDS?
XCT IOOUT,SIMIO ;NO, OUTPUT
JFCL ;IN CASE OUTPUT HAPPENED
SKIPGE B,-1(P) ;GET LINE NUMBER
JRST [MOVNS B
MOVNI A,5 ;ONLY PUT OUT 5 CHARS
JRST NOCONV] ;WAS GIVEN TO US IN TOTO
MOVNI A,6 ;PUT OUT TAB AFTER
MOVE C,[<ASCII /00000/>/2] ;TO MAKE 5
EXCH B,C
PUSH P,LNBAK ;RETURN ADDR
LNCONV: IDIVI C,=10
IORI D,"0"
DPB D,[POINT 7,(P),6]
SKIPE C ;THE RECURSIVE PRINTER
PUSHJ P,LNCONV
HLL C,(P) ;ONE CHAR, LEFT JUST
LSHC B,7
LNBAK: POPJ P,.+1
LSH B,1
TRO B,1
NOCONV: AOS C,OBP(CDB) ;MOVE OUT A WORD
MOVEM B,(C)
ADDM A,OCOWNT(CDB) ;UPDATE COUNT
MOVEI B,11
CAME A,[-5]
IDPB B,OBP(CDB) ;OUTPUT A TAB
NOTAB: MOVE LPSA,X33
JRST RESTR ;THAT'S IT
ENDCOM(LIN)
COMMENT ⊗Breakset,setbreak,stdbrk fakes⊗
;;% % MOVED IT TO STRSER
COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X33>,<CLOSE ROUTINES>)
COMMENT ⊗Close, Closin, Closo
CLOSE(CHAN)
CLOSIN closes only the input side
CLOSO closes only the output side
⊗
DSCR CLOSIN(CHAN)
CAL SAIL
⊗
HERE (CLOSIN) PUSHJ P,SAVE ;CLOSE INPUT ONLY
MOVEI D,1
JRST CLSS
DSCR CLOSO(CHANNEL);
CAL SAIL
⊗
HERE (CLOSO)
PUSHJ P,SAVE ;CLOSE OUTPUT ONLY
MOVEI D,2
JRST CLSS
DSCR CLOSE(CHANNEL);
CAL SAIL
⊗
.CLS:
HERE (CLOSE) ;CLOSE BOTH
PUSHJ P,SAVE ;SAVE ACS AND THINGS
CLSS:
;;%BQ% RHT 10-11-74 ALLOW CLOSE TO TAKE INHIBIT BITS AS AN ARGUMENT
;; FOLLOWING WAS MOVE LPSA,X22
MOVE LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
MOVE CHNL,-2(P) ;CHANNEL #
HRRZ D,-1(P) ;CHANNEL CLOSE INHIBIT BITS
;;%BQ% ↑
CHKCHN CHNL,<CLOSE> ;VERIFY OK CHANNEL
SKIPN CDB,@CDBLOC(USER) ;GET CDB
JRST RESTR ;NOT OPEN, DON'T CLOSE
XCT IOCLOSE,SIMIO ;CLOSE CHAN,SPEC
SETZM INAME(CDB)
SETZM ONAME(CDB) ;NO FILE NAMES OPEN
JRST RESTR ;RETURN
ENDCOM(CLS)
COMPIL(MTP,<MTAPE,USETI,USETO,RENAME,ERENAME>
,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
,<MTAPE, USETI, USETO, RENAME ROUTINES>)
COMMENT ⊗Mtape ⊗
DSCR MTAPE(CHANNEL,MODE);
CAL SAIL
⊗
.MTP:
HERE (MTAPE)
PUSHJ P,SAVE
MOVE LPSA,X33
MOVE CHNL,-2(P) ;CHANNEL NUMBER
LOADI7 A,<MTAPE>
PUSHJ P,GETCHN
LDB C,[POINT 5,-1(P),35] ;PART OF COMMAND CHAR
EXPO <
MOVEI B,101
CAIN C,11 ;MTAPE "I" DOES SPECIAL THINGS.
JRST MTAPQ ;GO SET IBM COMPABILITY MODE
>;EXPO
;;%##% ALLOW MTAPE(NULL) TO DO A MTAPE 0 -- WAIT
MOVEI B,0
JUMPE C,MTAPQ ;THIS IS DEFINITELY NOT A NO-OP
MOVE A,OPTAB ;COMMAND BITS
MOVE B,OPTAB+1 ;MORE
TRZE C,30 ;COMPRESS TABLE
ADDI C,5
LSH C,2 ;EACH COMMAND IS 4 BITS
ROTC A,(C) ;GET RIGHT COMMAND
ANDI B,17 ;DO IF SYSTEM DOESN'T
JUMPE B,[ERR <MTAPE: ILLEGAL CODE>,1
JRST RESTR]
MTAPQ: HRLI B,(<MTAPE>) ;CREATE MTAPE OPERATION
DPB CHNL,[POINT 4,B,12]
;%##% TRNE B,-1 ;IS THERE AN OPERATION?
XCT B ;YES, DO IT
JRST RESTR
OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,,,E,F,R,S,T
BYTE (4) 11,0,1 ;U,,W
COMMENT ⊗ Useti, Useto, Rename ⊗
DSCR USETI,USETO(CHANNEL,BLOCK #);
CAL SAIL
⊗
HERE (USETI)
↑↑.USETI:
SKIPA LPSA,[XCT IOSETI,SIMIO] ;USETI
HERE (USETO)
↑↑.USETO:
MOVE LPSA,[XCT IOSETO,SIMIO] ;USETO
PUSHJ P,SAVE
MOVE CHNL,-2(P)
LOADI7 A,<USET>
PUSHJ P,GETCHN
MOVE A,-1(P) ;VALUE TO USETO
MOVE LPSA+1,[JRST .+2] ;BE ABLE TO GET BACK
JRST LPSA ;GO TO USETI/O
MOVE LPSA,X33
JRST RESTR
DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
ERENAME(CHANNEL,"NEW NAME",PROT,DATE(0),TIME(0),MODE(0),@FLG);
CAL SAIL
⊗
HERE (RENAME)
↑↑.RENAME:
PUSHJ P,SAVE
SETZM @-1(P)
MOVE LPSA,X44
LOADI7 A,<RENAME>
MOVE CHNL,-3(P)
PUSHJ P,GETCHN
PUSHJ P,FILNAM ;PARSE FILENAME SPEC
JRST BDSPC ;SPECIFICATION NO GOOD
MOVE TEMP,-2(P)
TDZE TEMP,[XWD 777777,777000] ;MAKE THIS RENAME STERILE
ERR <ATTEMPT TO SET MODE OR DATE VIA RENAME.
USE ERENAME INSTEAD>,1
ROT TEMP,-=9
.RENIT: MOVEM TEMP,FNAME+2(USER)
XCT IORENAME,SIMIO ;DO THE RENAME
JRST RNERR ;NO GOOD
JRST RESTR
BDSPC: HRRZ TEMP,ERRTST(CDB) ;SEE IF
TRNE TEMP,10000 ;WILLING TO HANDLE ERROR
ERR <RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
SKIPA TEMP,[=8] ;ALWAYS REPORT CODE
RNERR: HRRZ TEMP,FNAME+1(USER) ;RETURN HORSESHIT NUMBER
HRROM TEMP,@-1(P) ;TO THE USER
JRST RESTR
;;%BY%
HEREFK(ERENAME,ERENA.)
PUSHJ P,SAVE
SETZM @-1(P)
MOVE LPSA,[XWD 7,7];
LOADI7 A,<ERENAME> ;
MOVE CHNL,-6(P);
PUSHJ P,GETCHN
PUSHJ P,FILNAM ;PARSE ID SPEC;
JRST BDSPC ;LOST
SKIPN TEMP,-4(P) ;DATE
JRST EREN.1 ;NO DATE
LDB C,[POINT 3,TEMP,=23] ;PICK UP HIGH ORDER BITS
DPB C,[POINT 3,FNAME+1(USER),=20] ;PUT THEM AWAY
EREN.1: MOVE C,-5(P) ;PROT
DPB C,[POINT =9,TEMP,=8] ;PUT AWAY
MOVE C,-2(P) ;MODE
DPB C,[POINT 4,TEMP,=12] ;PUT AWAY
MOVE C,-3(P) ;TIME
DPB C,[POINT =11,TEMP,=23] ;PUT AWAY
JRST .RENIT
;;%BY% ↑
ENDCOM(MTP)
COMMENT ⊗where Usercon used to be⊗
COMMENT ⊗Ttyuuo functions ⊗
DSCR TTYUUO FUNCTIONS
CAL SAIL
⊗
Comment ⊗
INTEGER PROCEDURE INCHRW;
RETURN A CHAR FROM TTCALL 0,
INTEGER PROCEDURE INCHRS;
RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)
STRING PROCEDURE INCHWL;
WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)
STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)
STRING PROCEDURE INSTR(INTEGER BRCHAR);
RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)
STRING PROCEDURE INSTRL(INTEGER BRCHAR);
WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)
STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
STR←INSTR(BRCHAR)
PROCEDURE OUTCHR(INTEGER CHAR);
OUTPUT CHAR (TTCALL 1)
PROCEDURE OUTSTR(STRING STR);
OUTPUT STR (TTCALL 3)
PROCEDURE CLRBUF;
CLEARS INPUT BUFFER (TTCALL 11,)
TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
TTYINL DOES A WAIT FOR LINE FIRST.
FULL BREAKSET CAPABILITIES EXCEPT FOR
"R" MODE (AND OF COURSE, LINE NUM. STUFF)
TITLE TTYUUO
⊗
;;%##% ADD TTYUP TO ALL THIS
COMPIL(TTY,,,,,,DUMMYFORSCISS)
DEFINE IENT1 <INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP>
DEFINE IENT2
<INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS>
DEFINE IEXT1
<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,BKTCHK,.SKIP.>
TYMSHR <DEFINE IEXT2 <DDFINA,INTRPT,.SONTP,SAVETY>
DEFINE IENT3 <BACKUP,IONEOU,TTYINL>> ;TYMSHR
NOTYMSHR < DEFINE IEXT2 <.SONTP>
NOTENX <DEFINE IENT3 <NOSTANFO<BACKUP,>TTYINL>> ;NOTENX
TENX <DEFINE IENT3 <TTYINL> > ;TENX >;NOTYMSHR
COMPXX (TTY,<IENT1,IENT2,IENT3>,<IEXT1,IEXT2>,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#
EXPO <
IFE ALWAYS,<
EXTERN OTSTRBF
>;IFE ALWAYS
>;EXPO
;;%##% FOR TTYUP THING
DEFINE KONVERT(AC) <
SKIPN TTYCVT(USER)
JRST .+5
CAIL AC,"a"
CAILE AC,"z"
JRST .+2
TRZ AC,40 ;FORCE TO BE LOWER CASE
>
TYMSHR <
HEREFK(IONEOU,IONOU.)
TTYUUO 15,-1(P)
SUB P,X22
JRST @2(P)
>;TYMSHR
HERE (INCHRW)
TYMSHR < SKIPE INTRPT
XCT DDFINA>;TYMSHR
TTCALL A
;;%##%
MOVE USER,GOGTAB
KONVERT (A)
POPJ P,
HERE (INCHRS) TTCALL 2,A ;SKIP IF CHAR WAITING
MOVNI A,1 ;ELSE RETURN -1
;;%##%
MOVE USER,GOGTAB
KONVERT(A)
POPJ P,
HERE (OUTCHR) TTYUUO 1,-1(P) ;OUTPUT THE PARAMETER
SUB P,X22 ;REMOVE PARAMETER
JRST @2(P)
HERE (OUTSTR)
;;#FO# 11-18-71 DCS (1-2)
EXPO <
;;#FO#
;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
;;#MM# 5-25-73 ! MAKE SURE ITS LOADED BEFORE WE USE IT
MOVE USER,GOGTAB
EXCH A,-1(SP) ;LENGTH OF STRING
HRRZS A ; REALLY
EXCH B,(SP) ;PTR TO THE STRING
PUSH P,C ;NEED ANOTHER AC
JUMPLE A,OU.OUT ;DON'T DO ANYTHING
OSLOOP: MOVE C,A
SUBI A,14*5-1 ;# CHARS/CHOMP
SKIPLE A ;LOTS LEFT??
MOVEI C,14*5-1 ; YES,
;;%##% BETTER PLACE THAN SGACS
MOVE LPSA,[POINT 7,OTSTRBF];AS GOOD A PLACE AS ANY
ILDB TEMP,B
SKIPE TEMP ;NULL??
IDPB TEMP,LPSA ; NO
SOJG C,.-3
MOVEI TEMP,0 ;A NULL FOR THE END
IDPB TEMP,LPSA
TTCALL 3,OTSTRBF ;RAISON D'ETRE
JUMPG A,OSLOOP
OU.OUT: POP SP,B
POP SP,A
POP P,C
POPJ P,
;;#HC#
;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
>;EXPO
NOEXPO <
HLRZ TEMP,(SP) ;SIZE/POSITION FIELDS OF BP
TRZ TEMP,7777 ;CLEAR SIZE FIELD
OR TEMP,-1(SP) ;POSITION, COUNT IN RH FOR DDTOUT
TRNN TEMP,7777 ;IF NULL STRING, QUIT
JRST QUIT
HRLM TEMP,(SP)
MOVE TEMP,[SIXBIT /TTY/] ;DEVICE FOR TTYMES
MOVEM TEMP,-1(SP)
MOVEI TEMP,-1(SP) ;POINT AT SPEC
CALLI TEMP,400047 ;WRITE FIRST CHAR FOR LENGTH CHARS
;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
JFCL ;IT HAS BEEN KNOW TO SKIP-RETURN
QUIT: SUB SP,X22 ;REMOVE THE ARGUMENT
>;NOEXPO
;;#FO#
POPJ P, ;DONE
TTWCHR←←=100 ;MAX NUMBER OF CHARS ON TTY INPUT
CMU < ;EXCEPT WE HAVE LARGER INPUT BUFFERS
TTWCHR←←=140
>;CMU
REDSTR: TYMSHR <
SKIPE INTRPT
XCT DDFINA
XCT @(P)
PUSHJ P,SAVETY
AOS -1(P) ;SKIP EXECUTED INSTRUCTION
> ; TYMSHR
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,TTWCHR
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVNI A,TTWCHR
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
TYMSHR <POP P,TEMP>;TYMSHR
POPJ P,
FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
TTCALL TEMP
FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
ADDI A,TTWCHR ;NUMBER USED
;;#GI# DCS 2-5-72 REMOVE TOPSTR
;;%##% ALLOW FOR ITERATIVE GETTING OF TTWCHR CHARS
HRROS -1(SP) ; TO STRING COUNT WORD
ADDM A,-1(SP) ;UPDATE COUNT WORD
;;#GI#
JRST RESTR
HERE (INSTR)
NOTYMSHR < PUSHJ P,SAVE>;NOTYMSHR
PUSHJ P,REDSTR
TYMSHR <JFCL>;TYMSHR
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X22 ;# TO REMOVE
INS1: PUUO 0,TEMP ;NEXT CHAR
;;%##%
KONVERT (TEMP) ;**** CONVERT BEFORE TEST BREAKEDNESS *****
INS2: CAMN TEMP,B ;BREAK?
JRST FINSTR ; YES, ALL DONE
IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
;;% % LDE BETTER NOT READ IN TOO MANY CHARACTERS
AOJL A,INS1 ; IF ROOM, GO BACK FOR MORE
PUSHJ P,CHRMOR ;MAKE ROOM, THEN GO BACK
JRST INS1 ;
HERE (INCHWL)
NOTYMSHR < PUSHJ P,SAVE>;NOTYMSHR
PUSHJ P,REDSTR
TYMSHR < TTCALL 4,TEMP>;TYMSHR
MOVE LPSA,X11
NOTYMSHR< TTCALL 4,TEMP>;NOTYMSHR
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
NOTYMSHR <
INS3: CAIE TEMP,12
NOCMU < ;WE WILL JUST BREAK ON CR OR LF, THANK YOU
EXPO <
CAIN TEMP,33 ;NORMAL ALTMODE.
>;EXPO
NOEXPO <
CAIN TEMP,175
>;NOEXPO
JRST DNSTR
CAIE TEMP,15 ;CR?
TRNE TEMP,600 ;CONTROL BITS ON?
>;NOCMU
CMU < CAIE TEMP,15 ;CR?
CAIN TEMP,12 ; OR LF?
>;CMU
JRST DNSTR ;YES
>;NOTYMSHR
TYMSHR <
INS3: CAIE TEMP,11
CAIL TEMP,40
SKIPA
JRST DNSTR
>;TYMSHR
;;%##%
KONVERT(TEMP)
IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY
;;=I08=
TTCALL 4,TEMP ;GET ANOTHER AND
;;%##% RHT -- MADE A BIT BETTER (ALLOW FOR GETTING MORE ROOM)
AOJL A,INS3 ;GO HANDLE IT (IF STILL HAVE ROOM)
PUSHJ P,CHRMOR ;GET ROOM FOR MORE CHARS
JRST INS3 ;GO HANDLE
DNSTR: MOVEM TEMP,.SKIP. ;SET BREAK CHAR
JRST FINSTR
;;#GF#
HERE (INCHSL)
NOTYMSHR < PUSHJ P,SAVE
MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN>;NOTYMSHR
PUSHJ P,REDSTR
TYMSHR < JFCL
MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN>;TYMSHR
SETOM @-1(P) ;ASSUME FAILED
TTCALL 5,TEMP ;ARE THERE CHARS?
JRST FINSTR ;NO
SETZM @-1(P) ;YES, GET THEM
;;#GF# DCS 2-1-72 (3-3)
JRST INS3 ;USE INCHWL'S LOOP, NOT INSTR'S
;;#GF#
HERE (INSTRL)
NOTYMSHR < PUSHJ P,SAVE
MOVE LPSA,X22>;NOTYMSHR
PUSHJ P,REDSTR
TYMSHR <TTCALL 4,TEMP
MOVE LPSA,X22>;TYMSHR
NOTYMSHR< TTCALL 4,TEMP>;NOTYMSHR
MOVE B,-1(P)
JRST INS2
HERE (INSTRS) PUSHJ P,SAVE
MOVE LPSA,X33
PUSHJ P,REDSTR
SETOM @-2(P)
TTCALL 5,TEMP
JRST FINSTR
SETZM @-2(P)
MOVE B,-1(P)
JRST INS2
HERE (CLRBUF) TTCALL 11,
POPJ P,
HERE (TTYINS)
NOTYMSHR < PUSHJ P,SAVE>;NOTYMSHR
PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
TYMSHR < JFCL>;TYMSHR
MOVE LPSA,X33
SETOM @-1(P) ;ASSUME NO CHARS
TTCALL 5,D ;SEE IF LINES WAITING
JRST FINS1 ;NONE WAINTING
;;%##% WILL DO INCHRW UUO IN LOOP
MOVE B,[TTCALL D]
JRST TYIN1 ;GO AHEAD
HERE (TTYINL)
NOTYMSHR <
PUSHJ P,SAVE
TTCALL 4,D ;WAIT FOR A LINE
MOVE B,[ TTCALL 4,D]
JRST TYIN
HERE (TTYIN) PUSHJ P,SAVE
TTCALL D ;GET A CHAR
MOVE B,[TTCALL D] ;FOR LOOP
TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
>;NOTYMSHR
TYMSHR<
PUSHJ P,REDSTR
TTCALL 4,TEMP
MOVE B,.-1
JRST TYIN
HERE (TTYIN) PUSHJ P,REDSTR
TTCALL TEMP
MOVE B,.-1
TYIN: HRRI B,D
MOVE D,TEMP
>;TYMSHR
MOVE LPSA,X33 ;PREPARE TO RETURN
TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
;;#TM# ! WAS -1(P)
MOVE X,-2(P) ;TABLE #
MOVEI TEMP,-1 ;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
PUSHJ P,BKTCHK ;CHECK TABLE #
JRST FINS1 ;ERROR OF SOME SORT
MOVE FF,BRKMSK(CHNL) ;GET MASK FOR THIS TABLE
ADD CHNL,CDB ;RELOCATE RANGE 1 TO 18
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(CHNL) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
;;%##% BREAK TABLE CONVERSION
TRNE FF,@BRKCVT(CDB) ;SPECIFY UC COERCION
TLOA C,400000 ;YES
TLZ C,400000 ;NO
;;%##%
MOVE Y,CDB
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(CDB)
JRST TTYN1
;;%##%
TTYN: XCT B ;1 CHAR
TTYN1:
;;%##%
JUMPGE C,TT.NUC ;COERCE BECAUSE OF BRK TBL ?
CAIL D,"a" ;ONLY IF LC
CAILE D,"z"
JRST TT.TSB ;GO TEST BREAK
TRZ D,40 ;MAKE UC
JRST TT.TSB
TT.NUC: KONVERT(D) ;MAY TURN TO UC BECAUSE OF TTY
TT.TSB:
;;%##%
TDNE FF,@Y ;BREAK OR OMIT?
JRST TTYSPC ; YES, FIND OUT WHICH
TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
;;%##% BE SURE DONT EAT MORE AT A TIME THAN CAN BLOAT
AOJL A,TTYN ;COUNT AND CONTINUE
TTNMOR: PUSHJ P,CHRMOR ;ALLOW FOR MORE CHARS
JRST TTYN ;GO GO GO
TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,FF
JRST TTYN ;OMIT
MOVEM D,@-1(P)
SKIPN Y,DSPTBL(CHNL) ;GET DISPOSITION WORDD FOR THIS TABLE
JRST FINS1 ;DONE, NO SAVE
JUMPL Y,TTYAPP ;APPEND
ERR <TTYIN: cannot retain break char>,1,FINS1
TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
ADDI A,1 ;ONE MORE HAPPY CHAR
JRST FINS1
;;%##% ALLOW FOR ANOTHER CHUNK OF CHARS
CHRMOR: ADDI A,TTWCHR ;A ← NUMBER CHARS USED
ADDM A,-1(SP) ;UPDATE COUNT
;;#UI# ! 1 OF 2
PUSH P,TEMP ;SOME PEOPLE HAVE A CHARACTER HERE
PUSH P,[TTWCHR] ;GET SOME MORE
PUSHJ P,.SONTP ;BE SURE ROOM & ALIGNED
;;#UI# ! 2 OF 2
POP P,TEMP ;WE JUST SAVED THIS
MOVNI A,TTWCHR ;REFRESH THE COUNT
POPJ P,
HERE(TTYUP)
;;%##% FLAGS TTY TRANSLATION TO UPPER CASE & RETURNS OLD FLAG
MOVE USER,GOGTAB
MOVE A,-1(P)
EXCH A,TTYCVT(USER)
SUB P,X22
JRST @2(P) ;RETURN
;;%CS%
NOTENX<
NOSTANFORD<
HEREFK(BACKUP,BACKU.)
TTYUUO 10,0
JFCL ;THIS CAN SKIP?
POPJ P,
>;NOSTANFORD
>;NOTENX
;;%CS% ↑
ENDCOM(TTY)
COMPIL(PTY,,,,,,DUMMYFORSCISS)
EXPO <
NOTYMSHR <
COMPXX(PTY)
>;NOTYMSHR
TYMSHR <
COMPXX(PTY,<AUXCLV,AUXCLR>,<X22,.SKIP.,DDFINA,INTRPT>,<AUXCAL ROUTINES>)
COMMENT !
AUXCLV (PORT,ARG,FUNCTION NUMBER)
AUXCLR IS SAME BUT ARG IS BY REFERENCE
IF FUNCTION NUMBER HAS BITS IN LEFT HAF FOR CALL BY
VALUE, ITS FOR AN "IMMEDIATE" TYPE INSTR LIKE SETSTS
BOTH FUCNTIONS RETURN A VALUE BUT IT HAS MEANING ONLY
IN SOME CASES (DEPENDS ON FUNCTION).
SETS .SKIP.
!
HEREFK(AUXCLV,AUXCV.)
POP P,1 ;RETURN ADDRESS
EXCH 1,-1(P) ;NOW ITS ARGUMENT
MOVE 2,[AUXCAL 3,1]
AUXCLC: POP P,3 ;FUNCTION
TLNE 3,-1
HRR 2,1 ;FOR IMMEDIATE
HRL 3,-1(P) ;GET PORT NUMBER
SETOM .SKIP.
SKIPE INTRPT
XCT DDFINA
XCT 2
SETZM .SKIP.
SUB P,X22
JRST @2(P)
HEREFK(AUXCLR,AUXCR.)
POP P,2
EXCH 2,-1(P) ;NOW ITS PARAMETER ADDRESS
MOVE 1,2 ;IN CASE FUNCTION WITH BITS IN LH
HRLI 2,(<AUXCAL 3,>)
JRST AUXCLC
>;TYMSHR
>;EXPO
NOEXPO <
COMPXX(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
ENTINT <PTYSTL,PTYGTL>>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,BKTCHK,.SKIP.>
,<PTY ROUTINES>)
COMMENT ⊗Ptyuuo functions ⊗
OPDEF PTYUUO [711B8]
DSCR PTYUUO FUNCTIONS
CAL SAIL
⊗
COMMENT ⊗
BEGIN "PTYSPC"
INTEGER PROCEDURE PTYGET;
PROCEDURE PTYREL(INTEGER LINE);
INTEGER PROCEDURE PTIFRE(INTEGER LINE);
INTEGER PROCEDURE PTOCNT(INTEGER LINE);
INTEGER PROCEDURE PTCHRS(INTEGER LINE);
PROCEDURE PTOCHS(INTEGER LINE,CHAR);
PROCEDURE PTOCHW(INTEGER LINE,CHAR);
PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
PROCEDURE LODED(STRING TRYAGAIN);
STRING PROCEDURE PTYALL(INTEGER LINE);
PROCEDURE BACKUP;
STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);
END "PTYSPC"
⊗
HERE (PTYGET)
SETOM .SKIP.
MOVEI A,0
PTYUUO A
SETZM .SKIP.
POPJ P,
HERE (PTYREL)
POP P,(P)
EXCH A,(P)
PTYUUO 1,A
POP P,A
JRST @2(P)
HERE (PTYGTL) PUSH P,(P) ;ANOTHER COPY OF RETURN ADDRESS.
PTYUUO 13,-2(P);POINT AT PTY LINE NUMBER
MOVE A,-1(P) ;RESULT.
SUB P,X33
JRST @3(P) ;AND RETURN.
HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
SUB P,X33
JRST @3(P)
HERE (PTIFRE)
MOVE TEMP,[PTYUUO 2,0]
JRST %PTY1
HERE (PTOCNT)
SKIPA TEMP,[PTYUUO 3,0]
HERE (PTCHRW)
MOVE TEMP,[PTYUUO 5,0]
%PTY1: POP P,(P)
EXCH 0,(P)
XCT TEMP
POP P,0
JRST @2(P)
HERE (PTCHRS)
POP P,(P)
EXCH 0,(P)
PTYUUO 4,0
MOVNI A,1
POP P,0
JRST @2(P)
HERE (PTOCHS)
SKIPA TEMP,[PTYUUO 6,0]
HERE (PTOCHW)
MOVE TEMP,[PTYUUO 7,0]
SETOM .SKIP.
POP P,(P)
EXCH A,(P)
EXCH 0,-1(P)
XCT TEMP
SETZM .SKIP.
POP P,A
POP P,0
JRST @3(P)
HERE (LODED)
MOVEI TEMP,0
EXCH TEMP,(P)
PUSH P,TEMP
SKIPA TEMP,[PTYUUO 15,-1(SP)]
HERE (PTOSTR)
MOVE TEMP,[PTYUUO 11,-1(SP)]
PUSH P,TEMP
MOVE USER,GOGTAB
PUSHJ P,INSET
PUSH SP,[1]
PUSH SP,[POINT 7,[0]]
PUSHJ P,CAT
POP P,TEMP
POP P,(P)
POP P,-1(SP)
XCT TEMP
SUB SP,X22
JRST @2(P)
HERE (BACKUP)
TTYUUO 10,
POPJ P,
HERE (PTYALL)
PUSHJ P,SAVE
MOVE 0,-1(P) ;LINE NUMBER
PTYUUO 3,0
JUMPE A,[PUSH SP,[0]
PUSH SP,[0]
JRST ALLQ]
MOVEI A,=450
ADDM A,REMCHR(USER)
SKIPL REMCHR(USER)
PUSHJ P,STRNGC
PUSHJ P,INSET
PUSH SP,-1(P) ;PTY LINE NUMBER
PUSH SP,TOPBYTE(USER) ;AND BYTE POINTER.
PTYUUO 10,-1(SP) ;AND ASK FOR ALL THAT IS THERE.
MOVEI B,0
MOVE C,(SP) ;BYTE POINTER.
;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
SOMMOR: MOVE LPSA,C ;LAG BY ONE #IN#
ILDB 0,C ;GET CHAR
JUMPE 0,ALLDUN
AOJA B,SOMMOR
ALLDUN: CAILE B,=445
ERR <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
HRROM B,-1(SP) ;SAVE AS RESULT.
MOVEM LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
;;#IN#
SUBI B,=156 ;-ESTIMATE
ADDM B,REMCHR(USER) ;AND UPDATE FREE COUTN.
ALLQ: MOVE LPSA,X22
JRST RESTR
%REDSTR:SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,=100
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVNI A,=100
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
%FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
;;#PO# ! RHT THIS USED TO BE CDB (=11) & MUNGED 12
;; USE C & D INSTEAD
PTYUUO 5,C ;HE USED TO SAY CDB
%FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
ADDI A,=100 ;NUMBER USED
HRROM A,-1(SP) ; AND TO STRING COUNT WORD
JRST RESTR
HERE (PTYSTR)
PUSHJ P,SAVE
PUSHJ P,%REDSTR
;;#PO#
MOVE C,-2(P)
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X33 ;# TO REMOVE
;;#PO# (2 LINES)
%INS1: PTYUUO 5,C ;NEXT CHAR
%INS2: CAMN D,B ;BREAK?
JRST %FINSTR ; YES, ALL DONE
;;#PO#
IDPB D,TOPBYTE(USER) ;PUT IT AWAY AND
AOJA A,%INS1 ; GO BACK FOR MORE
JRST %INS2
HERE (PTYIN) PUSHJ P,SAVE
;;#PO# (2 LINES)
MOVE C,-3(P)
PTYUUO 5,C
%TYIN: PUSHJ P,%REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,[XWD 4,4] ;PREPARE TO RETURN
%TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
MOVE X,-2(P) ;TABLE #
MOVEI TEMP,-1 ;BLOCK MUST BE THERE AND BE INIT'ED
PUSHJ P,BKTCHK ;CHECK TABLE #
JRST %FINS1 ;ERROR OF SOME SORT
MOVE FF,BRKMSK(CHNL) ;GET MASK FOR THIS TABLE
ADD CHNL,CDB ;RELOCATE RANGE 1 TO 18
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(CHNL) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVE Y,CDB ;BASE OF THIS GROUP
;;#PO# !
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(CDB)
JRST %TTYN1
;;#PO# !
%TTYN: PTYUUO 5,C
%TTYN1: TDNE FF,@Y ;BREAK OR OMIT?
JRST %TTYSPC ; YES, FIND OUT WHICH
;;#PO# !
%TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
AOJL A,%TTYN ;COUNT AND CONTINUE
JRST %FINS1 ;DONE
%TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,FF
JRST %TTYN ;OMIT
;;#PO# !
MOVEM D,@-1(P)
SKIPN Y,DSPTBL(CHNL) ;PICK UP DISPOSITION WORD
JRST %FINS1 ;DONE, NO SAVE
JUMPL Y,%TTYAPP ;APPEND
ERR <PTYIN: cannot retain break char>,1,%FINS1
;;#PO#
%TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
ADDI A,1 ;ONE MORE HAPPY CHAR
JRST %FINS1
>;NOEXPO
ENDCOM(PTY)
;;#XB ! JFR 6-17-76 TOPBYT and REMCHR removed from external list
COMPIL(TMP,<TMPIN,TMPOUT>
,<GOGTAB,STRNGC,INSET,CORGET,CORREL,X22,X44>
,<Tmpcor input and output routines>)
COMMENT ⊗ TMPIN (input from a tmpcor file)
;; SUBROUTINES SUPPLIED BY MJC -- 9 MARCH 1976
Call from a Sail program: STR←TMPIN(TMPFIL,@FLAG)
where TMPFIL and STR are strings and FLAG is boolean.
This routine fills STR with the contents of tmpcor file TMPFIL. FLAG is set to
true if the tmpcor file doesn't exist, and false otherwise. Accumulators A-F
and USER are used and not reset.
The address of the second word of STR's string descriptor and the address of
FLAG have been pushed onto the P stack, and TMPFIL's two descriptor words have
been pushed onto the SP stack. (Note that a Sail string descriptor consists
of two words: [constant flag,,length], [byte pointer].) Hence the parameters
are accessed as follows:
-1(P) contains the address of FLAG;
(SP) contains the byte pointer to TMPFIL; and
-1(SP) contains the flag/length word for TMPFIL.
TMPIN first asks the Sail system for a string of length =1284, in order to
accommodate the largest possible tmpcor file, and make sure it's aligned on a
word boundary. It then does a TMPCOR uuo to read the contents of the desired
tmpcor file into the string area. Accumulators E and F are used to hold the
two-word tmpcor information block. If the file doesn't exist, FLAG is set to
true (-1); otherwise, FLAG is set false, and the string descriptor for STR is
constructed. Unused string space is released, and TMPIN returns to the caller.
Sail features used are the following:
REMCHR(USER) # characters remaining in string space, negated
TOPBYT(USER) byte pointer to the first free character in string space
STRNGC string storage manager
INSET aligns TOPBYT to a word boundary
⊗
HEREFK(TMPIN,TMPIN.) ; *** Sail wants this.
BEGIN TMPIN
F←6
G←7
; Acquire a large chunk of string space, and remember where it starts.
MOVE USER,GOGTAB ; Get address of Sail's user table.
MOVEI A,4+5*400 ; Largest possible amt of string needed.
ADDM A,REMCHR(USER) ; REMCHR is # chars remaining in string space.
SKIPLE A,REMCHR(USER) ; Enough for my humongous string?
PUSHJ P,STRNGC ; No--go scrounge up some room.
PUSHJ P,INSET ; Make sure next string starts at word boundary.
HRRZ A,TOPBYT(USER) ; TOPBYT is now POINT 7,word.
MOVEI F,-1(A) ; Make address into right half of IOWD for TMPCOR.
HRLI F,-400 ; Fill in the length field of the IOWD.
; Get the tmpcor file name, put it into acc E for tmpcor uuo, and read the file.
HRRZ A,-1(SP) ; Get the length of the tmpcor file name.
MOVE B,(SP) ; Get the byte pointer to the name.
MOVE C,[POINT 6,E] ; Place to put it.
SETZ E, ; Initialize the name to zero.
SOJL A,GOTNAM
PUSHJ P,SIXCHR ; Turn the first character into sixbit, and put
SOJL A,GOTNAM ; it into tmpcor info.
PUSHJ P,SIXCHR ; Same for second and third characters, if any.
SOJL A,GOTNAM
PUSHJ P,SIXCHR
GOTNAM: MOVE A,[1,,E]
TMPCOR A, ; The word count is returned in A.
JRST NOFILE ; The desired tmpcor file wasn't there.
SETZM @-1(P) ; Get address of FLAG, and make it "false" (0).
; Turn the file contents into a Sail string, update all the relevant Sail
; pointers and counters, and return.
MAKEBP: MOVE B,TOPBYT(USER) ; Pointer to new string was formerly pointer to
MOVEM B,(SP) ; Point STR at the text we just read.
ADDI B,(A) ; Point the top-of-string-space pointer just
HRRM B,TOPBYT(USER) ; past the text (# words of text is in A).
IMULI A,5 ; Compute # characters of text.
HRLI A,40 ; Not a constant string
MOVEM A,-1(SP) ; Put that into STR's length field.
SUBI A,4+5*400 ; Free up all the unused string space by decreasing
ADDM A,REMCHR(USER) ; REMCHR (which is negative) by # of unused chars.
DONE: SUB P,X22 ; Pop addresses off P stack.
JRST @2(P) ; Go away.
; Tmpcor file didn't exist. Make FLAG "true" (-1) and return.
NOFILE: SETOM @-1(P)
SETZ A, ; Length of resulting string will be zero.
JRST MAKEBP
; The code for SIXCHR is on the next page.
BEND TMPIN
COMMENT ⊗ TMPOUT (output to a tmpcor file)
Call from a Sail program: TMPOUT(TMPFIL,STR,@FLAG)
where TMPFIL and STR are strings and FLAG is boolean.
This routine writes the string STR into tmpcor file TMPFIL. FLAG is set to true
if the tmpcor file could not be written, and false otherwise. Accumulators A-G
and USER are used and not reset. Since the TMPCOR uuo will not write an empty
tmpcor file, a null STR causes FLAG to be set true.
The address of FLAG has been pushed onto the P stack, and the string descriptor
words of TMPFIL and STR have been pushed onto the SP stack. Hence the parameters
are accessed as follows:
-1(P) contains the address of FLAG;
(SP) contains the byte pointer to STR;
-1(SP) contains the flag/length word for STR;
-2(SP) contains the byte pointer to TMPFIL; and
-3(SP) contains the flag/length word for TMPFIL.
TMPOUT first ascertains the length of the string to be written and acquires a
chunk of core of the appropriate size for use as a buffer. It then converts the
first three characters of TMPFIL to sixbit, copies STR to the buffer in order
to align it on a word boundary, and does the tmpcor output. Accumulators E and
F are used for the two-word tmpcor information block. TMPOUT then sets FLAG and
returns.
Sail features used are the following:
CORGET given the desired number of words of core in C, returns
the address of a block of that size in B (skip return if
success, direct return if failure)
CORREL given the address of a block in B, releases the block to
free storage (always direct return)
⊗
HEREFK(TMPOUT,TMPOU.) ; *** Sail wants this.
BEGIN TMPOUT
F←6
G←7
; Get the right amount of buffer space and fill in tmpcor info IOWD.
HRRZ C,-1(SP) ; Get length of STR.
ADDI C,9 ; Get enough words to hold the whole string plus
IDIVI C,5 ; an extra word, then change # chars to # words.
PUSH P,C ; Save the length (we'll need it for tmpcor info).
PUSHJ P,CORGET ; Get a buffer of the appropriate length.
JRST NOSTG ; Couldn't get the core.
MOVE G,B ; Address of block returned in B, so remember it.
MOVEI F,-1(B) ; Also store in address part of tmpcor info IOWD.
POP P,C ; Recall the length needed for the tmpcor file.
MOVNI C,-1(C) ; Make it into the length part of the IOWD.
HRL F,C ; Decremented since extra word was CORGETed.
; Copy STR to the buffer. Address of buffer is in B.
HRLI B,440700 ; Convert buffer address into POINT 7,buffer.
MOVE C,(SP) ; Get the byte pointer for STR.
HRRZ A,-1(SP) ; Length of STR.
;;#XY# !
SETZM (B) ;CLEAR FIRST WORD OF BUFFER
LOOP: SOJL A,CPYDON ; Done copying?
ILDB D,C ; No, copy another character.
IDPB D,B
;;#XY# !
SETZM 1(B) ;CLEAR NEXT WORD OF BUFFER
JRST LOOP
CPYDON:
; Get the tmpcor file name, put it into tmpcor info, and output the buffer.
HRRZ A,-3(SP) ; Get the length of the tmpcor file name.
MOVE B,-2(SP) ; Get the byte pointer to the name.
MOVE C,[POINT 6,E] ; Place to put it.
SETZ E, ; Initialize the name to zero.
SOJL A,GOTNAM
PUSHJ P,SIXCHR ; Turn the first character into sixbit, and put
SOJL A,GOTNAM ; it into TMPNFO.
PUSHJ P,SIXCHR ; Same for second and third characters, if any.
SOJL A,GOTNAM
PUSHJ P,SIXCHR
GOTNAM: MOVE A,[3,,E]
TMPCOR A, ; Write the buffer.
JRST NOWRIT ; Couldn't do it.
SETZM @-1(P) ; Get address of FLAG, and make it "false" (0).
DONE: MOVE B,G ; Return the buffer to free storage.
PUSHJ P,CORREL
XIT: SUB SP,X44 ; Pop all the string stuff.
SUB P,X22
JRST @2(P) ; Return.
; TMPCOR uuo direct-returned. Probably no more space for tmpcor files.
NOWRIT: SETOM @-1(P) ; Couldn't do output for some reason, so make
JRST DONE
; CORGET direct-returned.
NOSTG: ERR <Couldn't get core for buffer.> ; *** Sail wants this.
JRST XIT ; *** P and SP screwed up right now.
; Code for SIXCHR is on the next page.
BEND TMPOUT
COMMENT ⊗ SIXCHR (converts a character to sixbit)
This routine gets a character from a string specifying the name of a tmpcor
file (byte pointer in B), converts it to sixbit, and puts it into the tmpcor
info name field (byte pointer in C). It's called by PUSHJ P,SIXCHR in both
TMPIN and TMPOUT. Note that acc D is overwritten.
⊗
SIXCHR: ILDB D,B ; Get the ascii character.
TRZN D,100 ; If 100 bit is on, turn it off and skip.
TRZA D,40 ; Turn off 40 bit since 100 bit was off, and skip.
TRO D,40 ; Turn on 40 bit since 100 bit was on.
IDPB D,C ; Put the sixbit character into tmpcor info.
POPJ P,
ENDCOM(TMP)
IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗